I am able to retrieve user information from Active Directory as per below code. But how can I authorized current to edit and update their telephone numbers? This application is running in SharePoint server.
Dim netBIOSname As String = Me.Page.User.Identity.Name
Dim sAMAccountName As String = netBIOSname.Substring(netBIOSname.LastIndexOf("\"c) + 1)
txtuser.Text = sAMAccountName
Try
Dim userName As String = txtuser.Text
Dim searcher As New DirectoryServices.DirectorySearcher( _
"(mailNickname=" + userName + ")")
Dim result As DirectoryServices.SearchResult = searcher.FindOne()
If result Is Nothing Then
Label2.Text = "Unable to find user: " + userName
Else
Dim employee As DirectoryServices.DirectoryEntry = result.GetDirectoryEntry()
txtfirstname.Text = employee.Properties("givenName").Value.ToString()
txtlastname.Text = employee.Properties("sn").Value.ToString()
txtfullname.Text = employee.Properties("cn").Value.ToString()
txtempid.Text = employee.Properties("physicalDeliveryOfficeName").Value.ToString()
txttitle.Text = employee.Properties("title").Value.ToString()
txttele.Text = employee.Properties("telephoneNumber").Value.ToString()
txtdept.Text = employee.Properties("department").Value.ToString()
txtmobile.Text = employee.Properties("mobile").Value.ToString()
Dim ManagerName As String = employee.Properties("manager").Value.ToString()
ManagerName = ManagerName.Substring(3, ManagerName.IndexOf(",") - 3)
Dim searchMgr As New DirectoryServices.DirectorySearcher("(cn=" + ManagerName + ")")
Dim resultMgr As DirectoryServices.SearchResult = searchMgr.FindOne()
If resultMgr Is Nothing Then
Label2.Text = "Unable to find Manager: " + ManagerName
Else
Dim empManager As DirectoryServices.DirectoryEntry = resultMgr.GetDirectoryEntry()
searchMgr.Dispose()
resultMgr = Nothing
empManager.Close()
End If
searcher.Dispose()
result = Nothing
employee.Close()
End If
Catch ex As Exception
Label2.Text = "The following error occurred: " + ex.Message.ToString()
End Try
Related
it has been some days since I implemented in several PCs my Google Drive upload programme. It is developed in VB.NET console app and I can say it works out pretty good. Except that in some PCs it continues throwing the taskcanceled exception. Basically the programme works at night, where the internet traffic in the pcs should be likely to 0 and it continues trying to upload to a google folder until it succesfully do it OR the time (of an hour usually) runs out.
The Exception looks like this
Ex: System.AggregateException: One or more errors occured. ---> System.Threading.Tasks.TaskCanceledException: A task was canceled.
--- Fine della traccia dello stack dell'eccezione interna ---
in System.Threading.Tasks.Task.ThrowIfExceptional(Boolean includeTaskCanceledExceptions)
in System.Threading.Tasks.Task`1.GetResultCore(Boolean waitCompletionNotification)
in System.Threading.Tasks.Task`1.get_Result()
in Google.Apis.Upload.ResumableUpload.Upload() in C:\Apiary\2021-09-08.15-52-39\Src\Support\Google.Apis\Upload\ResumableUpload.cs:riga 388
in TeraDriveServ.Service1.UploadFile(String FilePath) in C:\Sviluppo\TeraDriveServ\Service1.vb:row 291
---> (Internal exception 0) System.Threading.Tasks.TaskCanceledException: A Task was canceled.<---
This is the code I use
Private Sub UploadFile(FilePath As String)
Dim pathDb As String = System.Configuration.ConfigurationManager.AppSettings("DB")
If Service.ApplicationName <> "Google Drive VB Dot Net" Then CreateService()
Dim mail As String = ""
Dim destinatari As String = ""
Dim TheFile As New Google.Apis.Drive.v2.Data.File()
Dim nome As String = Path.GetFileName(FilePath)
Dim infofile As New IO.FileInfo(FilePath)
' I get some data from the file
Dim dataultimaModifica As DateTime = infofile.LastWriteTime
Dim nomefileeffettivo As String = infofile.Name
Dim estensione = Path.GetExtension(FilePath)
'Getting the file folder
Dim folderId As String = System.Configuration.ConfigurationManager.AppSettings("CARTELLADRIVE")
TheFile.Parents = New List(Of ParentReference) From {New ParentReference() With {.Id = folderId}}
TheFile.Title = nome
TheFile.Description = ""
Dim esiste As Boolean = False
' A query to check if the file is uploaded
Using con As System.Data.SQLite.SQLiteConnection = New System.Data.SQLite.SQLiteConnection("data source=" & pathDb & "databaseFile.db3")
Using com As System.Data.SQLite.SQLiteCommand = New System.Data.SQLite.SQLiteCommand(con)
con.Open()
com.CommandText = "Select ID FROM CARICATI WHERE NOME = '" & nome & "' AND DATA='" & dataultimaModifica & "'"
Using reader As System.Data.SQLite.SQLiteDataReader = com.ExecuteReader()
While reader.Read()
esiste = True
End While
con.Close()
End Using
End Using
End Using
If esiste = True Then
' already loaded
Return
Else
Select Case estensione
Case ".bak"
TheFile.MimeType = "application/octet-stream"
Case ".zip"
TheFile.MimeType = "application/zip"
'Case ".jpeg", ".jpg"
' TheFile.MimeType = "image/ jpeg"
'Case ".txt"
' TheFile.MimeType = "text/plain"
'Case ".pdf"
' TheFile.MimeType = "application/pdf"
'Case ".xls"
' TheFile.MimeType = "application/ vnd.ms - excel"
'Case ".doc"
' TheFile.MimeType = "application/msword"
'Case ".docx"
' TheFile.MimeType = "application/vnd.openxmlformats-officedocument.wordprocessingml.document"
'Case ".xlsx"
' TheFile.MimeType = "application/vnd.openxmlformats-officedocument.spreadsheetml.sheet"
'Case ".odt"
' TheFile.MimeType = "application/ vnd.oasis.opendocument.text"
Case Else
' I dont like the file extension
Return
End Select
Dim fatto As Integer = 0
' I upload the file details in the DB
Using con As System.Data.SQLite.SQLiteConnection = New System.Data.SQLite.SQLiteConnection("data source=" & pathDb & "databaseFile.db3")
Using com As System.Data.SQLite.SQLiteCommand = New System.Data.SQLite.SQLiteCommand(con)
con.Open()
com.CommandText = "INSERT INTO CARICATI (NOME,DATA) VALUES('" & nome & "','" & dataultimaModifica & "') "
com.ExecuteNonQuery()
fatto = con.LastInsertRowId
' UPLOADED
con.Close()
End Using
End Using
End If
Try
Dim ByteArray As Byte() = System.IO.File.ReadAllBytes(FilePath)
Dim Stream As New System.IO.MemoryStream(ByteArray)
Dim UploadRequest As Google.Apis.Drive.v2.FilesResource.InsertMediaUpload = Service.Files.Insert(TheFile, Stream, TheFile.MimeType)
logger.Debug("Oggetto creato")
' UploadRequest.ContentStream.WriteTimeout = 600000
'If contaUp = 0 Then
' UploadRequest.Service.HttpClient.Timeout = Service.HttpClient.Timeout
'End If
'contaUp = 1
logger.Debug("Starting upload: " & DateTime.Now)
' Here is where the exception points at, the Google Upload() Method
UploadRequest.Upload()
logger.Debug("Upload completed: " & DateTime.Now)
Dim file As File = Nothing
file = UploadRequest.ResponseBody
If file Is Nothing Then
logger.Debug("Upload failed")
' deletes the data from db to try again
AnnulloCaricamento(nome, dataultimaModifica, pathDb)
Else
' I send some stuff to a server
logger.Debug("Cerco di fare POST")
Dim testoSucc As String = System.Configuration.ConfigurationManager.AppSettings("TESTOS")
POST(nomefileeffettivo, dataultimaModifica)
eseguito = True
End If
Catch ex As Exception
' deletes the data from db to try again
AnnulloCaricamento(nome, dataultimaModifica, pathDb) ''05/10/2021
End Try
End Sub
Thanks everyone
If (TextBoxStudentID.Text.ToString().Trim() <> "") Then
Dim adp1 As SqlDataAdapter = New SqlDataAdapter("select StudentName, StudentStandard, StudentBalance, EmailAddress, ContactNumber Active from StudentDetails where StudentID = '" + TextBoxStudentID.Text.ToString() + "'", con)
Dim ds1 As DataSet = New DataSet()
adp1.Fill(ds1)
If ds1.Tables.Count > 0 Then
If ds1.Tables(0).Rows.Count > 0 Then
TextBoxStudentName.Text = ds1.Tables(0).Rows(0)(0).ToString()
TextBoxStudentStd.Text = ds1.Tables(0).Rows(0)(1).ToString()
TextBoxCurrentBalance.Text = ds1.Tables(0).Rows(0)(2).ToString()
CheckBoxActive.Checked = Convert.ToBoolean(ds1.Tables(0).Rows(0)(3).ToString())
Else
MessageBox.Show("No student found for Student ID = " + TextBoxStudentID.Text.ToString(), "Search failed!")
TextBoxStudentName.Text = ""
TextBoxStudentStd.Text = ""
TextBoxCurrentBalance.Text = ""
TextBoxContactNumber.Text = ""
CheckBoxActive.Checked = False
End If
End If
End If
I wrote the above code to search for a particular roll number in the database I called. The error says "the string is not a valid boolean". kindly help.
Try:
Convert.ToBoolean(ds1.Tables(0).Rows(0)(5).ToString())
Column 3 is the email address. Also add a comma between ContactNumber and Active
I am tasked with making a simple GUI based database viewer. The database is hosted on our schools ftp server we must use visual basic and for the most part I've got it working I can search, view, and add to the database, but editing an existing record is giving me problems.
When I attempt to update the record I get a ora-00904 error invalid identifier when not using a colon (:) in where portion of the query and an ora-01008 not variables bound with a colon (:). We so far have only really used sqldeveloper and as a final project we were asked to use Visual Basic but we never covered anything like this in class so its a challenge I suppose.
PS: I only have that portion commented out so that I could view the error.
Private Sub btnSave_Click(sender As Object, e As EventArgs) Handles btnSave.Click
Dim strCustomerEmail As String = ""
Dim strLastName As String = ""
Dim strFirstName As String = ""
Dim strAddress As String = ""
Dim strCity As String = ""
Dim strState As String = ""
Dim intZip As Integer = 0
Dim datDateSignedUp As Date
Dim intCustomerNumber As Integer = 0
Try
strCustomerEmail = CStr(txtCustomerEmail.Text)
strLastName = CStr(txtLastName.Text)
strFirstName = CStr(txtFirstName.Text)
strAddress = CStr(txtAddress.Text)
strCity = CStr(txtCity.Text)
strState = CStr(txtState.Text)
intZip = CInt(txtZip.Text)
datDateSignedUp = CDate(txtDateSignedUp.Text)
intCustomerNumber = CInt(txtCustomerNumber.Text)
Dim sql As String = "UPDATE P_CLIENTS SET CUSTOMER_EMAIL = :CUSTOMER_EMAIL, LASTNAME = :LASTNAME, FIRSTNAME = :FIRSTNAME, ADDRESS = :ADDRESS, CITY = :CITY, STATE = :STATE, ZIP = :ZIP, DATE_SIGNED_UP = :DATE_SIGNED_UP, CUSTOMER# = :CUSTOMER# WHERE CUSTOMER_EMAIL = :EDIT_CUSTOMER_EMAIL"
Dim cmd2 As New OracleCommand(sql, conn)
conn.Open()
cmd2.Parameters.Add("CUSTOMER_EMAIL", strCustomerEmail)
cmd2.Parameters.Add("LASTNAME", strLastName)
cmd2.Parameters.Add("FIRSTNAME", strFirstName)
cmd2.Parameters.Add("ADDRESS", strAddress)
cmd2.Parameters.Add("CITY", strCity)
cmd2.Parameters.Add("STATE", strState)
cmd2.Parameters.Add("ZIP", intZip)
cmd2.Parameters.Add("DATE_SIGNED_UP", datDateSignedUp)
cmd2.Parameters.Add("EDIT_CUSTOMER_EMAIL", strEditCustomerEmail)
cmd2.CommandType = CommandType.Text
cmd2.ExecuteNonQuery()
txtCustomerEmail.Text = strEditCustomerEmail
txtLastName.Text = ""
txtFirstName.Text = ""
txtAddress.Text = ""
txtCity.Text = ""
txtState.Text = ""
txtZip.Clear()
txtDateSignedUp.Clear()
txtCustomerNumber.Clear()
'txtCustomerEmail.Select()
txtCustomerEmail.Enabled = True
txtLastName.Enabled = True
txtFirstName.Enabled = True
txtAddress.Enabled = True
txtCity.Enabled = True
txtState.Enabled = True
txtZip.Enabled = True
txtDateSignedUp.Enabled = True
txtCustomerNumber.Enabled = True
'Catch ex As Exception
' MessageBox.Show("An error occurred while attempting to add a new record.", "Error")
Finally
conn.Close()
txtCustomerEmail.Select()
End Try
End Sub
You are missing Customer# from your parameter list.
This is a bit of a weird question, and apologies for the vast amount of code the question contains, but, I've been given somebody else's project to maintain, and the user has come to me with an error. There is a button which opens the InputBox, seen below.
The form is used to enter a path of a file to import. If the user enters no path, or an incorrect one, an error is displayed - fine. Now, the problem is, is that if the user presses the 'Cancel' button or the x in the top right to close the form, it also returns the same error, saying that the path cannot be found.
After looking through the following code, I can't work out how to make it so that the error is not displayed when pressing the x or Cancel, so can anybody help me out at all?
Private Sub btnImport_Click(sender As Object, e As EventArgs) Handles btnImport.Click
Try
Dim importbox As String = InputBox("Input path", "Import", "")
Dim fi As New FileInfo(importbox)
Dim connectionString As String = "Provider=Microsoft.Jet.OLEDB.4.0;Extended Properties=Text;Data Source=" & fi.DirectoryName
Dim conn As New OleDbConnection(connectionString)
conn.Open()
Dim add1 As String = ""
Dim add2 As String = ""
Dim add3 As String = ""
Dim add4 As String = ""
Dim add5 As String = ""
Dim postcode As String = ""
Dim telephone As String = ""
Dim fax As String = ""
Dim email As String = ""
Dim customercode As String = ""
Dim customername As String = ""
Dim webpage As String = ""
Dim mobile As String = ""
Dim headerTable As DataTable = ugHeaders.DataSource
Dim csvArray(headerTable.Rows.Count) As String
Dim i As Integer = 0
For Each dr As DataRow In headerTable.Rows
csvArray(i) = dr.Item("CSVName")
Next
For Each dr As DataRow In headerTable.Rows
Select Case dr.Item("DBName").ToString.Trim
Case "Add1"
add1 = dr.Item("CSVName")
Case "Add2"
add2 = dr.Item("CSVName")
Case "Add3"
add3 = dr.Item("CSVName")
Case "Add4"
add4 = dr.Item("CSVName")
Case "Add5"
add5 = dr.Item("CSVName")
Case "PostCode"
postcode = dr.Item("CSVName")
Case "Telephone"
telephone = dr.Item("CSVName")
Case "Fax"
fax = dr.Item("CSVName")
Case "Email"
email = dr.Item("CSVName")
Case "Customer_Name"
customername = dr.Item("CSVName")
Case "Customer_Code"
customercode = dr.Item("CSVName")
Case "webpage"
webpage = dr.Item("CSVName")
Case "mobile_phone"
mobile = dr.Item("CSVName")
End Select
Next
Dim sqlSelect As String = "SELECT Company, [" & add1 & "], [" & add3 & "], [" & postcode & "], [" & add2 & "], " & _
"[" & telephone & "], [" & fax & "], [" & email & "], [" & customercode & "], " & _
"[" & add4 & "], [" & add5 & "], [" & webpage & "], [" & mobile & "] FROM " & fi.Name
Dim cmdSelect As New OleDbCommand(sqlSelect, conn)
Dim adapter1 As New OleDbDataAdapter(cmdSelect)
Dim ds As New DataSet
adapter1.Fill(ds, "DATA")
pb_progress.Maximum = ds.Tables(0).Rows.Count
pb_progress.Value = 0
For Each dr As DataRow In ds.Tables(0).Rows
Try
Debug.WriteLine(dr.Item(customercode).ToString.Trim)
If dr.Item(customercode).ToString.Trim = "" Then
Dim str As String = dr.Item(customername)
If str.Trim = "" Then Continue For
Dim length As Integer = str.Length
If length < 20 Then
Else
length = 20
End If
str = Replace(str.Substring(0, length), " ", "_").ToUpper
str = Regex.Replace(str, "[^a-zA-Z _&]", "")
Dim found As Boolean = True
Dim loopcount As Integer = 1
Do Until found = False
Dim checkSql As String = "SELECT * FROM Customers WHERE [Customer_Code] = #ccode"
Dim checkCmd As New OleDb.OleDbCommand(checkSql, con)
checkCmd.Parameters.AddWithValue("#ccode", str)
Dim checkDa As New OleDb.OleDbDataAdapter(checkCmd)
Dim checkDt As New DataTable
checkDa.Fill(checkDt)
If checkDt.Rows.Count <> 0 Then
found = True
str &= CStr(loopcount)
loopcount += 1
Else
found = False
End If
Loop
dr.Item(customercode) = str
Else
Dim found As Boolean = True
Dim loopcount As Integer = 1
Do Until found = False
Dim checkSql As String = "SELECT * FROM Customers WHERE [Customer_Code] = #ccode"
Dim checkCmd As New OleDb.OleDbCommand(checkSql, con)
checkCmd.Parameters.AddWithValue("#ccode", dr.Item(customercode))
Dim checkDa As New OleDb.OleDbDataAdapter(checkCmd)
Dim checkDt As New DataTable
checkDa.Fill(checkDt)
If checkDt.Rows.Count <> 0 Then
found = True
dr.Item(customercode) &= CStr(loopcount)
loopcount += 1
Else
found = False
End If
Loop
End If
Dim sql As String
sql = "INSERT INTO Customers(Customer_Code, Customer_Name, Contract_Payment_Terms, Aq_Date, Telephone, Fax, Email, Average_Payment_Terms, webpage, mobile_phone) " & _
"VALUES(#ccode, #cname, 30, #01/01/2016#, #ctele, #cfax, #email, 30, #webpage, #mobile);"
Dim cmd As New OleDb.OleDbCommand(sql, con)
With cmd.Parameters
.AddWithValue("#ccode", dr.Item(customercode))
.AddWithValue("#cname", dr.Item(customername))
.AddWithValue("#ctele", dr.Item(telephone).ToString.Truncate(48))
.AddWithValue("#cfax", dr.Item(fax))
.AddWithValue("#email", dr.Item(email))
.AddWithValue("#webpage", dr.Item(webpage))
.AddWithValue("#mobile", dr.Item(mobile))
End With
cmd.ExecuteNonQuery()
sql = "INSERT INTO [Customer_Addresses] (Cust_Code, PostCode, Alias, Add1, Add2, Add3, Add4, Add5) VALUES(#ccode, #pcode, 'Default'" & _
",#add1, #add2, #add3, #add4, #add5);"
cmd = New OleDb.OleDbCommand(sql, con)
With cmd.Parameters
.AddWithValue("#ccode", dr.Item(customercode))
.AddWithValue("#pcdoe", dr.Item(postcode))
.AddWithValue("#add1", dr.Item(add1))
.AddWithValue("#add2", dr.Item(add2))
.AddWithValue("#add3", dr.Item(add3))
.AddWithValue("#add4", dr.Item(add4))
.AddWithValue("#add5", dr.Item(add5))
End With
cmd.ExecuteNonQuery()
Catch ex As Exception
Debug.WriteLine(ex.Message)
End Try
pb_progress.Increment(1)
Next
MsgBox("Import successful", MsgBoxStyle.OkOnly, "Success")
Catch ex As Exception
errorLog(ex)
End Try
End Sub
Inputbox will always return a String.
If the Users presses "OK" it will return the String put into the TextBox.
If he cancels the box by pressing X or Cancel it returns "".
I would generally not recommend using an Inputbox for getting a filepath. Use an OpenFileDialog instead. If you have the fullpath already in your Clipboard you can just paste it into the Filename-Textboxof the OFD and press enter.
This should get you started:
Dim ofd as new OpenFileDialog()
// Show the File Dialog to the user and detect he pressed OK or Cancelled
if ofd.ShowDialog = Windows.Forms.DialogResult.OK
// Always check, if the file really exists
if IO.File.exists(ofd.FileName)
importbox = ofd.FileName
Else
msgbox("File does not exist")
Exit Sub
End if
Else
Exit Sub
End if
I am trying to understand how the MailEnable API works.
So far, I could only look at the AJAX documentation and got the LOGIN command work. It's like:
AJAXRequest('LOGIN','Username='user'&Password='pass', false);
That command returns an xml string like
<BASEELEMENT SCHEMA="VALUE" METHOD="LOGIN"><RETURNVALUE>1</RETURNVALUE></BASEELEMENT>
That working well, anything else than the LOGIN command (For example LOG-OFF or LIST-MESSAGES) gives me a timeout error like
<BASEELEMENT SCHEMA="TIMEOUT" METHOD="LOGOUT"></BASEELEMENT>
The commands I am using for LOG-OFF and LIST-MESSAGES are these and they both give me the below error.
AJAXRequest('LIST-MESSAGES','Folder=/Inbox', false);
AJAXRequest('LOG-OFF','ID=', false);
I am using the example files from that link. I just can't understand if I am missing something, or these examples and documentations are not up to date or has issues or smth?
Thanks!
(I couldn't find "mailenable" tag to tag this question. It's a pity that noone has tagged mailenable before in stackoverflow, mailenable forum is like a grave :S)
Ok as per comments I am posting a self written Mail Api for MailEnable
Imports System
Imports System.Web
Imports MailEnable.Administration
Imports QueryStringModule
Imports System.Xml
Public Class MailApi : Implements IHttpHandler
Public ReadOnly Property IsReusable() As Boolean Implements IHttpHandler.IsReusable
Get
Return False
End Get
End Property
Public Sub ProcessRequest(ByVal context As HttpContext) Implements IHttpHandler.ProcessRequest
Dim doc As XmlDocument = GetXmlToShow(context)
context.Response.ContentType = "test/xml"
context.Response.ContentEncoding = System.Text.Encoding.UTF32
context.Response.Expires = -1
context.Response.Cache.SetAllowResponseInBrowserHistory(True)
doc.Save(context.Response.Output)
End Sub
Private Function GetXmlToShow(context As HttpContext) As XmlDocument
Dim Result As String = ""
Dim doc As New XmlDocument
Try
Dim query As String = QueryStringModule.Decrypt(context.Request.QueryString("val").Replace(" ", "+"))
Dim PostOffice As String = HttpUtility.ParseQueryString(query).Get("PostOffice")
Dim Domain As String = HttpUtility.ParseQueryString(query).Get("Domain")
Dim Username As String = HttpUtility.ParseQueryString(query).Get("Username")
Dim Password As String = HttpUtility.ParseQueryString(query).Get("Password")
Dim MailBoxQuota As Integer = CInt(Val(HttpUtility.ParseQueryString(query).Get("MailBoxQuota")))
If MailBoxQuota = 0 Then
MailBoxQuota = 102400
End If
Dim act As String = HttpUtility.ParseQueryString(query).Get("Action")
Select Case act
Case "Create"
Result = fnCreateMailAccount(Username, PostOffice)
Case "Delete"
Case "Update"
Case "GetAll"
Result = fnGetAll(Username, PostOffice)
Case "GetToday"
Case "GetFromTo"
Case "GetUnread"
Result=fnGetUnread(Username,PostOffice)
Case "GetRead"
Case "GetUnreadCount"
Result = fnGetUnreadCount(Username, PostOffice)
Case "GetTotalCount"
Result = fnGetTotalCount(Username, PostOffice)
Case Else
Result = "<result status=""Err""><reason>Invaid action!</reason></result>"
End Select
doc.LoadXml(Result)
Catch ex As Exception
Result = "<result status=""Err""><reason>" + ex.Message + "</reason></result>"
doc.LoadXml(Result)
End Try
Return doc
End Function
Private Function fnGetUnread(Username As String, Postoffice As String) As String
Dim XMLFile As String = ""
Try
If Len(Username) <= 0 Or Len(Postoffice) <= 0 Then
Throw New ArgumentException("Invalid Parameters!")
Else
Dim oMailbox As New MailEnable.Administration.Mailbox
oMailbox.Postoffice = Postoffice
oMailbox.MailboxName = Username
oMailbox.Status = 1
If oMailbox.GetMailbox() = 1 Then
Dim APIResult As Long
Dim oStore As New MailEnable.Store
APIResult = oStore.StoreFolder_Open(Postoffice, Username, "\Inbox", 0, 1)
If oStore.StoreFolder_FindFirstItem() = 1 Then
Do
If oStore.StoreItem_GetProperty("PR_ME_READ").ToString = "0" Or oStore.StoreItem_GetProperty("PR_ME_READ").ToString = "" Then
Dim WrapperStart As String = "<message>"
Dim ItemId As String = "<itemid>" + oStore.StoreItem_GetProperty("ME_ITEM_ID").ToString + "</itemid>"
Dim MessageDate As String = "<dated>" + Left(oStore.StoreItem_GetProperty("PR_ME_MESSAGEDATE").ToString, 10) + " " + Right(oStore.StoreItem_GetProperty("PR_ME_MESSAGEDATE").ToString, 8) + "</dated>"
Dim Attachments As String = "<attachments>" + oStore.StoreItem_GetProperty("PR_ME_ATTACHMENTS").ToString + "</attachments>"
Dim From As String = "<from>" + oStore.StoreItem_GetProperty("PR_ME_FROM").ToString.Replace("<", """").Replace(">", """") + "</from>"
Dim Subject As String = "<subject>" + oStore.StoreItem_GetProperty("PR_SUBJECT").Replace("<", """").Replace(">", """").ToString + "</subject>"
Dim Size As String = "<size>" + oStore.StoreItem_GetProperty("PR_ME_SIZE").ToString + "</size>"
Dim Status As String = "<status>" + oStore.StoreItem_GetProperty("PR_ME_FLAGSTATUS").ToString + "</status>"
Dim WrapperEnd As String = "</message>"
XMLFile = XMLFile + WrapperStart +ItemId + MessageDate + Attachments + From + Subject + Size + Status + WrapperEnd
End If
Loop While (oStore.StoreFolder_FindNextItem() = 1)
XMLFile = "<messages>" + XMLFile + "</messages>"
End If
APIResult = oStore.StoreFolder_FindClose()
APIResult = oStore.StoreFolder_Close()
Else
Throw New ArgumentException("Invalid Mailbox!")
End If
End If
XMLFile = "<result status=""Success"">" + XMLFile + "</result>"
Catch ex As Exception
XMLFile = "<result status=""Err""><reason>" + ex.Message + "</reason></result>"
End Try
Return XMLFile
End Function
Private Function fnGetAll(Username As String, Postoffice As String) As String
Dim XMLFile As String = ""
Try
If Len(Username) <= 0 Or Len(Postoffice) <= 0 Then
Throw New ArgumentException("Invalid Parameters!")
Else
Dim oMailbox As New MailEnable.Administration.Mailbox
oMailbox.Postoffice = Postoffice
oMailbox.MailboxName = Username
oMailbox.Status = 1
If oMailbox.GetMailbox() = 1 Then
Dim APIResult As Long
Dim oStore As New MailEnable.Store
APIResult = oStore.StoreFolder_Open(Postoffice, Username, "\Sent Items", 0, 1)
If oStore.StoreFolder_FindFirstItem() = 1 Then
Do
Dim WrapperStart As String = "<message>"
Dim ItemId As String="<itemid>"+oStore.StoreItem_GetProperty("ME_ITEM_ID").ToString +"</itemid>"
Dim MessageDate As String = "<dated>" + Left(oStore.StoreItem_GetProperty("PR_ME_MESSAGEDATE").ToString, 10) + " " + Right(oStore.StoreItem_GetProperty("PR_ME_MESSAGEDATE").ToString, 8) + "</dated>"
Dim Attachments As String = "<attachments>" + oStore.StoreItem_GetProperty("PR_ME_ATTACHMENTS").ToString + "</attachments>"
Dim From As String = "<from>" + oStore.StoreItem_GetProperty("PR_ME_FROM").ToString.Replace("<", """").Replace(">", """") + "</from>"
Dim Subject As String = "<subject>" + oStore.StoreItem_GetProperty("PR_SUBJECT").Replace("<", """").Replace(">", """").ToString + "</subject>"
Dim Size As String = "<size>" + oStore.StoreItem_GetProperty("PR_ME_SIZE").ToString + "</size>"
Dim Status As String = "<status>" + oStore.StoreItem_GetProperty("PR_ME_FLAGSTATUS").ToString + "</status>"
Dim WrapperEnd As String = "</message>"
XMLFile = XMLFile + WrapperStart + ItemId + MessageDate + Attachments + From + Subject + Size + Status + WrapperEnd
Loop While (oStore.StoreFolder_FindNextItem() = 1)
XMLFile = "<messages>" + XMLFile + "</messages>"
End If
APIResult = oStore.StoreFolder_FindClose()
APIResult = oStore.StoreFolder_Close()
Else
Throw New ArgumentException("Invalid Mailbox!")
End If
End If
XMLFile = "<result status=""Success"">" + XMLFile + "</result>"
Catch ex As Exception
XMLFile = "<result status=""Err""><reason>" + ex.Message + "</reason></result>"
End Try
Return XMLFile
End Function
Private Function fnGetTotalCount(Username As String, Postoffice As String) As String
Dim XMLFile As String = ""
Dim c As Integer = 0
Try
If Len(Username) <= 0 Or Len(Postoffice) <= 0 Then
Throw New ArgumentException("Invalid Parameters!")
Else
Dim oMailbox As New MailEnable.Administration.Mailbox
oMailbox.Postoffice = Postoffice
oMailbox.MailboxName = Username
oMailbox.Status = 1
If oMailbox.GetMailbox() = 1 Then
Dim APIResult As Long
Dim oStore As New MailEnable.Store
APIResult = oStore.StoreFolder_Open(Postoffice, Username, "\Inbox", 0, 1)
If oStore.StoreFolder_FindFirstItem() = 1 Then
Do
c = c + 1
Loop While (oStore.StoreFolder_FindNextItem() = 1)
XMLFile = "<count>" + c.ToString + "</count>"
End If
APIResult = oStore.StoreFolder_FindClose()
APIResult = oStore.StoreFolder_Close()
Else
Throw New ArgumentException("Invalid Mailbox!")
End If
End If
XMLFile = "<result status=""Success"">" + XMLFile + "</result>"
Catch ex As Exception
XMLFile = "<result status=""Err""><reason>" + ex.Message + "</reason></result>"
End Try
Return XMLFile
End Function
Private Function fnGetUnreadCount(Username As String, Postoffice As String) As String
Dim XMLFile As String = ""
Dim c As Integer = 0
Try
If Len(Username) <= 0 Or Len(Postoffice) <= 0 Then
Throw New ArgumentException("Invalid Parameters!")
Else
Dim oMailbox As New MailEnable.Administration.Mailbox
oMailbox.Postoffice = Postoffice
oMailbox.MailboxName = Username
oMailbox.Status = 1
If oMailbox.GetMailbox() = 1 Then
Dim APIResult As Long
Dim oStore As New MailEnable.Store
APIResult = oStore.StoreFolder_Open(Postoffice, Username, "\Inbox", 0, 1)
If oStore.StoreFolder_FindFirstItem() = 1 Then
Do
If oStore.StoreItem_GetProperty("PR_ME_READ").ToString = "0" Or oStore.StoreItem_GetProperty("PR_ME_READ").ToString = "" Then
c = c + 1
End If
Loop While (oStore.StoreFolder_FindNextItem() = 1)
XMLFile = "<count>" + c.ToString + "</count>"
End If
APIResult = oStore.StoreFolder_FindClose()
APIResult = oStore.StoreFolder_Close()
Else
Throw New ArgumentException("Invalid Mailbox!")
End If
End If
XMLFile = "<result status=""Success"">" + XMLFile + "</result>"
Catch ex As Exception
XMLFile = "<result status=""Err""><reason>" + ex.Message + "</reason></result>"
End Try
Return XMLFile
End Function
Private Function fnCreateMailAccount(Username As String, Postoffice As String) As String
Dim XMLFile As String = ""
Dim MailBoxQuota As Long = 102400
Try
If Len(Username) > 0 And Len(Postoffice) > 0 Then
Dim oPostoffice As New MailEnable.Administration.Postoffice
Dim oDomain As New MailEnable.Administration.Domain
oPostoffice.Account = Postoffice
oPostoffice.Name = Postoffice
oPostoffice.Host = Postoffice
oPostoffice.Status = 1
If oPostoffice.GetPostoffice <> 1 Then
CreatePostoffice(Postoffice, New Guid().ToString.Substring(20))
End If
Dim oLogin As New MailEnable.Administration.Login
oLogin.Account = Postoffice
oLogin.LastAttempt = -1
oLogin.LastSuccessfulLogin = -1
oLogin.LoginAttempts = -1
oLogin.Password = ""
oLogin.Rights = ""
oLogin.Status = -1
oLogin.UserName = Username & "#" & Postoffice
If oLogin.GetLogin <> 1 Then
oLogin.LastAttempt = 0
oLogin.LastSuccessfulLogin = 0
oLogin.LoginAttempts = 0
oLogin.Password = Right(Guid.NewGuid().ToString, 16)
oLogin.Rights = "USER"
oLogin.Status = 1
'Create Login
If oLogin.AddLogin = 1 Then
End If
oLogin = Nothing
Dim oMailbox As New MailEnable.Administration.Mailbox
oMailbox.Postoffice = Postoffice
oMailbox.MailboxName = Username
oMailbox.RedirectAddress = ""
oMailbox.RedirectStatus = 0
oMailbox.Size = 0
oMailbox.Limit = MailBoxQuota
oMailbox.Status = 1
'Create Mailbox
If oMailbox.AddMailbox = 1 Then
'
' Mailbox was added - What could go wrong!
'
End If
oMailbox = Nothing
' Finally, we need to assign address map(s) for the mailbox
Dim oAddressMap As New MailEnable.Administration.AddressMap
oAddressMap.Account = Postoffice
oAddressMap.DestinationAddress = "[SF:" & Postoffice & "/" & Username & "]"
oAddressMap.SourceAddress = "[SMTP:" & Username & "#" & Postoffice & "]"
oAddressMap.Scope = 0
If oAddressMap.AddAddressMap = 1 Then
'
' Address Map was added too - What could go wrong!
'
End If
oAddressMap = Nothing
XMLFile = "<result status=""Success""></result>"
Else
Throw New ArgumentException("Account already exists!")
End If
Else
Throw New ArgumentException("Invalid Parameters!")
End If
Catch ex As Exception
XMLFile = "<result status=""Err""><reason>" + ex.Message + "</reason></result>"
End Try
Return XMLFile
End Function
Function CreatePostoffice(sPostoffice As String, sPassword As String) As String
Dim oPostOffice As New MailEnable.Administration.Postoffice
Dim oMailbox As New MailEnable.Administration.Mailbox
Dim oLogin As New MailEnable.Administration.Login
Dim lResult As Long
CreatePostoffice = False
If Len(sPostoffice) > 0 And Len(sPassword) > 0 Then
oPostOffice.Account = sPostoffice
oPostOffice.Name = sPostoffice
oPostOffice.Status = 1
lResult = oPostOffice.AddPostoffice
If (lResult = 1) Then
oMailbox.Postoffice = sPostoffice
oMailbox.Limit = -1
oMailbox.MailboxName = "Postmaster"
oMailbox.RedirectAddress = ""
oMailbox.RedirectStatus = 0
oMailbox.Status = 1
lResult = oMailbox.AddMailbox
If (lResult = 1) Then
oLogin.Account = sPostoffice
oLogin.Description = "Postmaster Mailbox"
oLogin.Password = sPassword
oLogin.Rights = "ADMIN"
oLogin.Status = 1
oLogin.UserName = "Postmaster#" & sPostoffice
lResult = oLogin.AddLogin
If (lResult = 1) Then
CreatePostoffice = True
End If
End If
End If
End If
oPostoffice = Nothing
oMailbox = Nothing
oLogin = Nothing
End Function
End Class
Though this is not the complete answer, you can start working on it. This way.
Place this ashx code in your MailEnable webmail folder and request from your application.
QueryStringModule is a available to download here
QueryStringModule is used in your application to encrypt http requests and decrypt at MailEnable application.
Allow only your application IP at MailEnable web application for security reasons.