Listbox in dynamic web user controls lost data after postback - vb.net

I create dynamic web user control which has a list box and a textbox. However, data in the list box is lost after postback but the data in the textbox isn't.
I've read a lot of forums and pages about web user controls and I understands that web user controls recreate after such post-back.
Could you please show me the way to get data of list box before post back ?
Thank alot
'--------------------------------------
Note that: my web user control has a list and text boxes, user can add value to the list box by entering values in the text box ( I wrote functions in javascripts to add data from text box to list box) .
However, in the main page, when I click a button to save data of the list, all of my page and my web user control are reloaded, so data in the list box is also disappear :-(
Code VB for adding web user control:
Private Sub WebFormTestValidation_Init(sender As Object, e As EventArgs) Handles Me.Init
Dim ctrList As wucListPerson
ctrList = LoadControl("wucListPerson.ascx")
Me.Panel1.Controls.Add(ctrList)
ctrList.ID = "wucDynamic"
ctrList.wucName = "DYNAMIC TEST"
ctrList.wucInfo = "DYNAMIC TEST"
End Sub
'----------------------
Code VB of web user control
Public Class wucListPerson
Inherits System.Web.UI.UserControl
Public Property lstPersons As List(Of String)
Get
Dim lst As New List(Of String)
If lstFullName.Items.Count > 0 Then
For i = 0 To lstFullName.Items.Count - 1
lst.Add(CStr(lstFullName.Items(i).Value))
Next
End If
Return lst
End Get
Set(ByVal lstValues As List(Of String))
If lstValues.Count > 0 Then
For i = 0 To lstValues.Count - 1
Dim strArr As String() = Split(CStr(lstValues.Item(i)), "*")
Ordre.Text = CStr(strArr(0))
Nom.Text = strArr(1)
Prenom.Text = strArr(2)
hdfIdPersonne.Value = strArr(3)
Dim item As New System.Web.UI.WebControls.ListItem
item.Text = strArr(0) + "." + strArr(1) + " " + strArr(2)
item.Value = CStr(lstValues.Item(i))
lstFullName.Items.Add(item)
Next
End If
End Set
End Property
Public Property wucName As String
Get
Return lblName.Text
End Get
Set(ByVal value As String)
lblName.Text = value
End Set
End Property
Public Property wucInfo As String
Get
Return Info.Text
End Get
Set(ByVal value As String)
Info.Text = value
End Set
End Property
Public Sub addPersonne(ByVal ordre As Integer, ByVal nom As String, ByVal prenom As String, idpersonne As Integer)
'lstName.Items.Add(CStr(ordre) + "." + nom + " " + prenom, CStr(ordre) + "*" + nom + "*" + prenom + "*" + CStr(idpersonne))
Dim item As New System.Web.UI.WebControls.ListItem
item.Text = CStr(ordre) + "." + nom + " " + prenom
item.Value = CStr(ordre) + "*" + nom + "*" + prenom + "*" + CStr(idpersonne)
lstFullName.Items.Add(item)
End Sub
Public Function getList() As List(Of String)
Dim lst As New List(Of String)
If lstFullName.Items.Count > 0 Then
For i = 0 To lstFullName.Items.Count - 1
lst.Add(CStr(lstFullName.Items(i).Value))
Next
End If
Return lst
End Function
Public Sub SetList(ByVal lst As List(Of String))
If lst.Count > 0 Then
For i = 0 To lst.Count - 1
Dim strArr As String() = Split(CStr(lst.Item(i)), "*")
Ordre.Text = CStr(strArr(0))
Nom.Text = strArr(1)
Prenom.Text = strArr(2)
hdfIdPersonne.Value = strArr(3)
Dim item As New ListItem
item.Text = strArr(0) + "." + strArr(1) + " " + strArr(2)
item.Value = CStr(lst.Item(i))
lstFullName.Items.Add(item)
Next
End If
End Sub
Protected uniqueKey As String
Private Sub Page_Load(sender As Object, e As EventArgs) Handles Me.Load
'If Not Page.IsPostBack Then
' lblName.Text = wucName
'End If
Me.uniqueKey = Guid.NewGuid.ToString("N")
Me.cmdRight.Attributes("onclick") = ("RemoveItem_" + (uniqueKey + "(); return false;"))
Me.cmdLeft.Attributes("onclick") = ("AddItem_" + (uniqueKey + "(); return false;"))
Me.cmdInfor.Attributes("onclick") = ("showHideInfor_" + (uniqueKey + "(); return false;"))
If Trim(lblName.Text) = "" Then cmdInfor.Visible = False
End Sub
End Class
'----------------------
Code Javascript to get/ remove data from text boxes to the list
//===================
function getMaxOrdre_<%=uniqueKey%>() {
var listName = document.getElementById("<%=lstFullName.ClientID()%>");
var lst = listName.options;
var count = lst.length;
if (lst.length == 0) {
return 0;
}
var max = 0;
for (var i = 0; i < count; i++) {
var item = lst[i].value;
var FName = getFullName_<%=uniqueKey%>(item);
if (parseInt(FName.Ordre) > max) {
max = FName.Ordre;
}
}
return max;
}
//===================
function getFullName_<%=uniqueKey%>(FullName) {
if (FullName.length != "0") {
var temp = new Array();
temp = FullName.split('*');
return { Ordre: temp[0], Nom: temp[1], PreNom: temp[2], IdPersonne: temp[3] };
}
return { Ordre: 0, Nom: '', PreNom: '', IdPersonne: '0' };
}
//===================
function AddItem_<%=uniqueKey %>() {
//lstName.BeginUpdate();
var txtOrdre = document.getElementById("<%=Ordre.ClientID()%>");
var txtNom = document.getElementById("<%=Nom.ClientID()%>");
var txtPrenom = document.getElementById("<%=Prenom.ClientID()%>");
var hdfIdPerson = document.getElementById("<%=hdfIdPersonne.ClientID%>");
var listName = document.getElementById("<%=lstFullName.ClientID()%>");
var index = listName.selectedIndex;
var lst = listName.options;
var ordre = txtOrdre.value;
var nom = txtNom.value;
var prenom = txtPrenom.value;
var idPerson = hdfIdPerson.value;
if ((nom.length > 0) || (prenom.length > 0)) {
var selectBoxOption = document.createElement("option");//create new option
selectBoxOption.value = ordre + '*' + nom + '*' + prenom + '*' + idPerson;//set option value
selectBoxOption.text = ordre + '.' + nom + ' ' + prenom;//set option display text
listName.add(selectBoxOption, null);//add created option to select box.
};
// lstName.EndUpdate();
//get deafault data
var ordreMax = getMaxOrdre_<%=uniqueKey%>();
txtOrdre.value = parseInt(ordreMax) + 1;
txtNom.value = '';
txtPrenom.value = '';
hdfIdPerson.value = '0';
}
//===================
function RemoveItem_<%=uniqueKey %>() {
//lstName.BeginUpdate();
var txtOrdre = document.getElementById("<%=Ordre.ClientID()%>");
var txtNom = document.getElementById("<%=Nom.ClientID()%>");
var txtPrenom = document.getElementById("<%=Prenom.ClientID()%>");
var hdfIdPerson = document.getElementById("<%=hdfIdPersonne.ClientID%>");
var listName = document.getElementById("<%=lstFullName.ClientID()%>");
var index = listName.selectedIndex;
var lst = listName.options;
if (index >= 0) {
var FName = getFullName_<%=uniqueKey %>(lst[index].value);
txtOrdre.value = FName.Ordre;
txtNom.value = FName.Nom;
txtPrenom.value = FName.PreNom;
hdfIdPerson.value = FName.IdPersonne;
listName.remove(index);
}
}

Your problem is that you are adding the new items in the DOM, but these changes will not necessarily be reflected in your ListBox after a page refresh or PostBack. I could suggest two solutions:
1) Add the elements in the ListBox through .net instead of using Javascript.
but if you need a client side solution so that your page won't refresh everytime you add an item:
2) Add a .net HiddenField control. These controls have the advantage of being accessible easily from both Client Side and Server Side. You can add each item in both, the ListItem and the HiddenField (maybe comma separated) and on the server side you will use this HiddenField instead of your ListBox.

Related

Dropbox API Upload Wait for asynchronous function

guys
I'm having difficulty with the Dropbox API in uploading.
I have a list of files, and in each pass of the for I call the function that uploads:
Public Function Upload(ByVal ArquivoOrigem As String, ByVal ArquivoDestino As String)
Try
Dim fileStream As FileStream = New FileStream(ArquivoOrigem, FileMode.Open)
Me.CtrlTask = Task.Run(Function() Upload_Executar(fileStream, ArquivoDestino))
Me.CtrlTask.Wait()
Catch ex As Exception
End Try
End Function
Private Async Function Upload_Executar(ByVal fileStream As FileStream, ByVal ArquivoDestino As String) As Task
Me.ArquivoUploadIs = False
Try
Dim numChunks As Integer = CInt(Math.Ceiling(CDbl(fileStream.Length) / Me.chunkSize))
Dim buffer As Byte() = New Byte(Me.chunkSize - 1) {}
Dim sessionId As String = Nothing
Console.WriteLine("Chunk upload file...")
Console.WriteLine("fileStream.Length: " + fileStream.Length.ToString())
Console.WriteLine("chunkSize: " + Me.chunkSize.ToString())
Console.WriteLine("numChunks: " + numChunks.ToString())
For idx = 0 To numChunks - 1
Dim Porc1 As Integer = 0
Dim Porc2 As Integer = 0
Porc1 = CInt((idx / numChunks) * 100)
Porc2 = idx * Me.chunkSize
Console.WriteLine("Posicao: " + idx.ToString() + " / Total: " + numChunks.ToString() + " / Porc1: " + Porc1.ToString() + " / Total Transferido: " + FormatBytes(Porc2) + " / Tamanho Total: " + FormatBytes(fileStream.Length))
Dim byteRead = fileStream.Read(buffer, 0, Me.chunkSize)
Using memStream As MemoryStream = New MemoryStream(buffer, 0, byteRead)
If idx = 0 Then
Console.WriteLine("memStream.Length: " + memStream.Length.ToString())
Console.WriteLine("UploadSessionStartAsync")
Dim result = Await Dbx.Files.UploadSessionStartAsync(False, memStream)
Console.WriteLine(result)
sessionId = result.SessionId
Console.WriteLine("sessionId: " + sessionId)
Else
Dim cursor As UploadSessionCursor = New UploadSessionCursor(sessionId, CULng((Me.chunkSize * idx)))
If idx = numChunks - 1 Then
Console.WriteLine("UploadSessionFinishAsync")
Dim CtrlUp = Await Dbx.Files.UploadSessionFinishAsync(cursor, New CommitInfo(ArquivoDestino), memStream)
If CtrlUp.Id <> "" Then
Me.ArquivoUploadIs = True
End If
Else
Console.WriteLine("UploadSessionAppendV2Async")
Await Dbx.Files.UploadSessionAppendV2Async(cursor, body:=memStream)
End If
End If
End Using
Next
Catch ex As Exception
ShowMsgError(ex)
End Try
End Function
And I call her through the task, using "wait" to wait for the submission to finish before going to the next file:
Upload("C:\Arq1.pdf", "/Arq1.pdf");
Upload("C:\Arq2.pdf", "/Arq2.pdf");
Upload("C:\Arq3.pdf", "/Arq3.pdf");
Upload("C:\Arq4.pdf", "/Arq4.pdf");
However, while the upload is done the application is stuck.
To test put a thread, however, this causes all files in my list to be sent at the same time and I want to send one, wait for it to finish and then send the next one.
Does anyone have any suggestions?
You should avoid using .Wait as it can cause deadlocks.
Public Async Function Upload(ByVal ArquivoOrigem As String, ByVal ArquivoDestino As String) As Task
Try
Dim fileStream As FileStream = New FileStream(ArquivoOrigem, FileMode.Open)
Await Upload_Executar(fileStream, ArquivoDestino))
Catch ex As Exception
End Try
End Function
Await Upload("C:\Arq1.pdf", "/Arq1.pdf");
Await Upload("C:\Arq2.pdf", "/Arq2.pdf");
Await Upload("C:\Arq3.pdf", "/Arq3.pdf");
Await Upload("C:\Arq4.pdf", "/Arq4.pdf");

VB linq to entities Field called FIELD_NAME does not exist

I have spent the last hours trying to figure out what is causing this exception : Field called GENDER_DESC does not exist. Here are my codes:
Public Class RelationPatient
Public PatNetId As String
Public PatNetIdRel As String
Public Nom As String
Public Prenom As String
Public Sexe As String
Public TypeRel As String
Public Ordre As String
Public DateEnrol As Date
End Class
Public Shared Function GetRelPatient(ByVal PatNetId As String) As List(Of RelationPatient)
Using context As New DAL.SanteReprodEntities
context.Database.Connection.Open()
Dim patient As List(Of RelationPatient)
patient = (From p In context.PAT_REL
Join pa In context.PATIENTS.Include("GENDER_REF") On p.PAT_NET_ID_REL Equals (pa.PAT_NET_ID)
Join pn In context.PAT_NAME On pn.PAT_NET_ID Equals (p.PAT_NET_ID_REL)
Where p.PAT_NET_ID = PatNetId _
And p.VOIDED = 2 Select New RelationPatient With {.PatNetId = p.PAT_NET_ID, .PatNetIdRel = p.PAT_NET_ID_REL, .Nom = pn.LASTNAME, .Prenom = pn.FIRSTNAME, .Sexe = pa.GENDER_REF.GENDER_DESC, .TypeRel = p.REL_TYPE_ID, .Ordre = p.PATIENT_INDEX_TEMOIN, .DateEnrol = pa.ENROL_DATE}).ToList
Return patient
context.Database.Connection.Close()
End Using
End Function
Private Sub FrmLienPatient_Shown(sender As Object, e As EventArgs) Handles MyBase.Shown
DsEnrolement.PAT_REL.Clear()
DsEnrolement.Merge(DAL.dalManager.GetPatRelation(PAT_NET_ID))
Dim patRel As List(Of DAL.RelationPatient)
Dim sexe As String = String.Empty
patRel = DAL.dalManager.GetRelPatient(PAT_NET_ID)
If patRel IsNot Nothing Then
If patRel.Count > 0 Then
For Each rel As DAL.RelationPatient In patRel
MsgBox(rel.PatNetIdRel + ", " + rel.Nom + ", " + rel.Prenom + ", " + rel.Sexe + ", " + rel.TypeRel + ", " + rel.Ordre + ", " + rel.DateEnrol.ToShortDateString) 'This message is displayed well
PATI_RELDataGridView.Rows.Add(New String() {rel.PatNetIdRel, rel.Nom, rel.Prenom, sexe, rel.TypeRel, rel.Ordre, rel.DateEnrol.ToShortDateString}) 'Even if I put any string there like PATI_RELDataGridView.Rows.Add(New String() {"", "", "", "", "", "", ""}) the result is the same
Next
End If
End If
End Sub
Thanks in advance for your help.

VB.Net - Adwords API Get Domain Keywords, CPC And Search Volume

Function 1:
Public Function DomainKeywords(ByVal url As String) As String
Dim output As String = ""
Dim user As AdWordsUser = New AdWordsUser
Using targetingIdeaService As TargetingIdeaService = CType(user.GetService(AdWordsService.v201710.TargetingIdeaService), TargetingIdeaService)
Dim selector As New TargetingIdeaSelector()
selector.requestType = RequestType.IDEAS
selector.ideaType = IdeaType.KEYWORD
selector.requestedAttributeTypes = New AttributeType() {AttributeType.KEYWORD_TEXT, AttributeType.SEARCH_VOLUME, AttributeType.AVERAGE_CPC, AttributeType.CATEGORY_PRODUCTS_AND_SERVICES}
Dim searchParameters As New List(Of SearchParameter)
Dim relatedToUrlSearchParameter As New RelatedToUrlSearchParameter
relatedToUrlSearchParameter.urls = New String() {url}
relatedToUrlSearchParameter.includeSubUrls = False
searchParameters.Add(relatedToUrlSearchParameter)
Dim languageParameter As New LanguageSearchParameter()
Dim hebrew As New Language()
hebrew.id = 1027
languageParameter.languages = New Language() {hebrew}
searchParameters.Add(languageParameter)
Dim locationParameter As New LocationSearchParameter()
Dim israel As New Location
israel.id = 2376
locationParameter.locations = New Location() {israel}
searchParameters.Add(locationParameter)
selector.searchParameters = searchParameters.ToArray()
selector.paging = New Paging
Dim page As New TargetingIdeaPage()
Dim offset As Integer = 0
Dim pageSize As Integer = 180
Try
Dim i As Integer = 0
Do
selector.paging.startIndex = offset
selector.paging.numberResults = pageSize
page = targetingIdeaService.get(selector)
Dim keywordCheck As List(Of String) = New List(Of String)
If Not page.entries Is Nothing AndAlso page.entries.Length > 0 Then
For Each targetingIdea As TargetingIdea In page.entries
For Each entry As Type_AttributeMapEntry In targetingIdea.data
Dim ideas As Dictionary(Of AttributeType, AdWords.v201710.Attribute) = MapEntryExtensions.ToDict(Of AttributeType, AdWords.v201710.Attribute)(targetingIdea.data)
Dim keyword As String = DirectCast(ideas(AttributeType.KEYWORD_TEXT), StringAttribute).value
Dim averageMonthlySearches As Long = DirectCast(ideas(AttributeType.SEARCH_VOLUME), LongAttribute).value
'''''''''''''''''''This Returns a Wrong Number
Dim cpc As Money = DirectCast(ideas(AttributeType.AVERAGE_CPC), MoneyAttribute).value
Dim microedit As String = Math.Round(cpc.microAmount / 1000000, 2).ToString + "$"
''''''''''''''''''
Dim isExist As Boolean = False
For Each keycheck In keywordCheck
If keyword = keycheck Then
isExist = True
End If
Next
If isExist = False Then
keywordCheck.Add(keyword)
If output = String.Empty Then
output = keyword + "###" + microedit + "###" + averageMonthlySearches.ToString
Else
output = output + Environment.NewLine + keyword + "###" + microedit + "###" + averageMonthlySearches.ToString
End If
End If
Next
i = i + 1
Next
End If
offset = offset + pageSize
Loop While (offset < page.totalNumEntries)
Catch e As Exception
If output = String.Empty Then
output = "ERROR"
If e.Message.Contains("Rate exceeded") Then
MsgBox("rate exceeded")
Else
MsgBox(e.Message.ToString)
End If
End If
End Try
End Using
Return output
End Function
This function gets a url as input and returns keywords that relevant to that url as output in the following format:
KeywordName1###CPC###SearchVolume
KeywordName2###CPC###SearchVolume
for some reason no matter what website I type in it returns 180 results,
Im aware that pageSize is set to 180,
In-fact if you lower pageSize to 179, you only get 179 results, the problem is that i cant get more then 180 results whatsoever..
Optional help: also why the CPC value returned in the first function is different from the CPC value returned from that function:
Function 2:
Public Function KeywordCPC(keyName As String, Optional Tries As Integer = 0) As String
Dim output As String = ""
Dim user As AdWordsUser = New AdWordsUser
Using trafficEstimatorService As TrafficEstimatorService = CType(user.GetService(AdWordsService.v201710.TrafficEstimatorService), TrafficEstimatorService)
Dim keyword3 As New Keyword
keyword3.text = keyName
keyword3.matchType = KeywordMatchType.EXACT
Dim keywords As Keyword() = New Keyword() {keyword3}
Dim keywordEstimateRequests As New List(Of KeywordEstimateRequest)
For Each keyword As Keyword In keywords
Dim keywordEstimateRequest As New KeywordEstimateRequest
keywordEstimateRequest.keyword = keyword
keywordEstimateRequests.Add(keywordEstimateRequest)
Next
Dim adGroupEstimateRequest As New AdGroupEstimateRequest
adGroupEstimateRequest.keywordEstimateRequests = keywordEstimateRequests.ToArray
adGroupEstimateRequest.maxCpc = New Money
adGroupEstimateRequest.maxCpc.microAmount = 1000000
Dim campaignEstimateRequest As New CampaignEstimateRequest
campaignEstimateRequest.adGroupEstimateRequests = New AdGroupEstimateRequest() {adGroupEstimateRequest}
Dim countryCriterion As New Location
countryCriterion.id = 2376
Dim languageCriterion As New Language
languageCriterion.id = 1027
campaignEstimateRequest.criteria = New Criterion() {countryCriterion, languageCriterion}
Try
Dim selector As New TrafficEstimatorSelector
selector.campaignEstimateRequests = New CampaignEstimateRequest() {campaignEstimateRequest}
selector.platformEstimateRequested = False
Dim result As TrafficEstimatorResult = trafficEstimatorService.get(selector)
If ((Not result Is Nothing) AndAlso (Not result.campaignEstimates Is Nothing) AndAlso (result.campaignEstimates.Length > 0)) Then
Dim campaignEstimate As CampaignEstimate = result.campaignEstimates(0)
If ((Not campaignEstimate.adGroupEstimates Is Nothing) AndAlso (campaignEstimate.adGroupEstimates.Length > 0)) Then
Dim adGroupEstimate As AdGroupEstimate = campaignEstimate.adGroupEstimates(0)
If (Not adGroupEstimate.keywordEstimates Is Nothing) Then
For i As Integer = 0 To adGroupEstimate.keywordEstimates.Length - 1
Dim keyword As Keyword = keywordEstimateRequests.Item(i).keyword
Dim keywordEstimate As KeywordEstimate = adGroupEstimate.keywordEstimates(i)
If keywordEstimateRequests.Item(i).isNegative Then
Continue For
End If
Dim meanAverageCpc As Long = 0L
Dim meanAveragePosition As Double = 0
Dim meanClicks As Single = 0
Dim meanTotalCost As Single = 0
If (Not (keywordEstimate.min Is Nothing) AndAlso Not (keywordEstimate.max Is Nothing)) Then
If (Not (keywordEstimate.min.averageCpc Is Nothing) AndAlso Not (keywordEstimate.max.averageCpc Is Nothing)) Then
meanAverageCpc = CLng((keywordEstimate.min.averageCpc.microAmount + keywordEstimate.max.averageCpc.microAmount) / 2)
End If
End If
output = Math.Round(meanAverageCpc / 1000000, 2).ToString + "$"
Next i
End If
End If
Else
output = "ZERO"
End If
Catch e As Exception
If output = String.Empty Then
output = "ERROR"
If e.Message.Contains("Rate exceeded") Then
output = KeywordCPC(keyName, Tries + 1)
End If
End If
End Try
End Using
Return output
End Function
how can I get EXCAT CPC in the first function?
because now only the second function return good CPC and the
first function return the wrong CPC(checked in israeli adwords frontend)
If you want to know how to use the functions (for beginners):
VB.Net - Trying To Increase the efficiency of adwords API requests

How to get GLatLng object from address string in advance in google maps?

I want to get latlng object in google maps in advance. Basically my json result is returning array of address which I need to convert to glatlng to use for markers. But if i will use GeoCoder object then it will send asynch request which I don't want.
Is there any way other than GeoCoder object to convert an address string to GLatLng object?
You can take a look at the json object returned by any query to the maps api.
Then you use the json serializer in system.web.extensions to serialize the json into a class that you have to create from the JSONresponses which you analyze manually.
Note that you can get localized language return results by adding this to the http web request:
wrHTTPrequest.UserAgent = "Lord Vishnu/Transcendental (Vaikuntha;Supreme Personality of Godness)"
wrHTTPrequest.Headers.Add("Accept-Language:" + System.Globalization.CultureInfo.CurrentCulture.Name)
wrHTTPrequest.ContentType = "text/html"
Edit:
The example, from one of my files (remove all the SharpMap.Map stuff, it requires an external assembly.
Copyright (C) 2010 Me. Permission is hereby granted to use it for
good, not evil - if you add me to your thanks list.
Public Class _Default
Inherits System.Web.UI.Page
Protected smmGlobalMap As SharpMap.Map
'http://www.java2s.com/Code/VB/Development/ListallCultureInformation.htm
Public Sub listcultures()
'Dim x As System.DateTime = DateTime.Now
'Response.Write(x.ToString("HH':'mm':'ss MMM d', 'yyyy 'PST'", New System.Globalization.CultureInfo("zh-CN", False)))
Dim info As System.Globalization.CultureInfo
For Each info In System.Globalization.CultureInfo.GetCultures(System.Globalization.CultureTypes.AllCultures)
Response.Write("Deutsch: " + info.DisplayName + " English: " + info.EnglishName + " Native: " + info.NativeName + " Name: " + info.Name + " Codepage: " + info.TextInfo.ANSICodePage.ToString() + "<br />")
If Not info.IsNeutralCulture Then
'item.SubItems.Add(amount.ToString("C", info.NumberFormat))
'item.SubItems.Add(dateNow.ToString("d", info.DateTimeFormat))
End If
Next
End Sub
Public Sub GeoCodeTest()
'Dim GeoCodeResponse As Google.Maps.JSON.cGeoCodeResponse = GetJSONgeodata("San Bernardino, Switzerland")
'Dim GeoCodeResponse As Google.Maps.JSON.cGeoCodeResponse = GetJSONgeodata("北京")
'Dim GeoCodeResponse As Google.Maps.JSON.cGeoCodeResponse = GeoCodeRequest("San Bernardino, Switzerland")
Dim GeoCodeResponse As Google.Maps.JSON.cGeoCodeResponse = GeoCodeRequest("北京")
Response.Write(Seri(GeoCodeResponse))
Response.Write("<br /><br /><br />")
Response.Write(GeoCodeResponse.results(0).address_components(0).long_name)
Response.Write("<br /><br />")
Response.Write(GeoCodeResponse.results(0).geometry.location.lat.ToString)
Response.Write("<br />")
Response.Write(GeoCodeResponse.results(0).geometry.location.lng.ToString)
Response.Write("<br /><br /><br />")
Response.Write(GeoCodeResponse.results(0).geometry.viewport.northeast.lat.ToString)
Response.Write("<br />")
Response.Write(GeoCodeResponse.results(0).geometry.viewport.northeast.lng.ToString)
Response.Write("<br /><br /><br />")
End Sub
Public Function Seri(ByRef GeoData As Google.Maps.JSON.cGeoCodeResponse) As String
Dim jssJSONserializer As System.Web.Script.Serialization.JavaScriptSerializer = New System.Web.Script.Serialization.JavaScriptSerializer()
Dim CommentData As New Google.Maps.JSON.cGeoCodeResponse
Dim str As String = jssJSONserializer.Serialize(GeoData)
Return str
End Function
' http://www.codeproject.com/KB/IP/httpwebrequest_response.aspx
' http://www.linuxhowtos.org/C_C++/socket.htm
' http://en.wikipedia.org/wiki/List_of_countries_by_GDP_(PPP)_per_capita
Public Function GeoCodeRequest(ByRef strAddress As String) As Google.Maps.JSON.cGeoCodeResponse
strAddress = System.Web.HttpUtility.UrlEncode(strAddress) ' Add reference to System.Web
Dim strURL As String = "http://maps.google.com/maps/api/geocode/json?address=" + strAddress + "&sensor=false"
' *** Establish the request
Dim wrHTTPrequest As System.Net.HttpWebRequest = DirectCast(System.Net.WebRequest.Create(strURL), System.Net.HttpWebRequest)
' *** Set properties
wrHTTPrequest.Method = "GET"
wrHTTPrequest.Timeout = 10000 ' 10 secs
wrHTTPrequest.UserAgent = "Lord Vishnu/Transcendental (Vaikuntha;Supreme Personality of Godness)"
wrHTTPrequest.Headers.Add("Accept-Language:" + System.Globalization.CultureInfo.CurrentCulture.Name)
wrHTTPrequest.ContentType = "text/html"
' *** Retrieve request info headers
Dim wrHTTPresponse As System.Net.HttpWebResponse = DirectCast(wrHTTPrequest.GetResponse(), System.Net.HttpWebResponse)
' My Windows' default code-Page
Dim enc As System.Text.Encoding = System.Text.Encoding.GetEncoding(1252)
' Google's code-page
enc = System.Text.Encoding.UTF8
Dim srResponseStream As New System.IO.StreamReader(wrHTTPresponse.GetResponseStream(), enc)
Dim strJSONencodedResponse As String = srResponseStream.ReadToEnd()
wrHTTPresponse.Close()
srResponseStream.Close()
If String.IsNullOrEmpty(strJSONencodedResponse) Then
Return Nothing
End If
Dim jssJSONserializer As System.Web.Script.Serialization.JavaScriptSerializer = New System.Web.Script.Serialization.JavaScriptSerializer()
Dim GeoCodeResponse As New Google.Maps.JSON.cGeoCodeResponse
GeoCodeResponse = jssJSONserializer.Deserialize(Of Google.Maps.JSON.cGeoCodeResponse)(strJSONencodedResponse)
Return GeoCodeResponse
End Function
Public Function GetJSONgeodata(ByVal strAddress As String) As Google.Maps.JSON.cGeoCodeResponse
'strAddress = "Zurich, Switzerland"
strAddress = System.Web.HttpUtility.UrlEncode(strAddress) ' Add reference to System.Web
Dim strURL As String = "http://maps.google.com/maps/api/geocode/json?address=" + strAddress + "&sensor=false"
Dim wwwClient As Net.WebClient = Nothing
Dim strJSONtranslatedText As String = Nothing
Try
'http://www.stevetrefethen.com/blog/UsingGoogleMapsforGeocodinginC.aspx
wwwClient = New Net.WebClient()
wwwClient.Encoding = System.Text.Encoding.UTF8
strJSONtranslatedText = wwwClient.DownloadString(strURL)
Catch ex As Exception
MsgBox(ex.Message)
Finally
wwwClient.Dispose()
wwwClient = Nothing
End Try
If String.IsNullOrEmpty(strJSONtranslatedText) Then
Return Nothing
End If
Dim jssJSONserializer As System.Web.Script.Serialization.JavaScriptSerializer = New System.Web.Script.Serialization.JavaScriptSerializer()
Dim GeoCodeRespone As New Google.Maps.JSON.cGeoCodeResponse
GeoCodeRespone = jssJSONserializer.Deserialize(Of Google.Maps.JSON.cGeoCodeResponse)(strJSONtranslatedText)
Return GeoCodeRespone
End Function
' http://sharpmap.codeplex.com/wikipage?title=CustomTheme
' http://sharpmap.codeplex.com/Thread/View.aspx?ThreadId=28205
Protected Sub Page_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
'GeoCodeTest()
listcultures()
'Set up the map
smmGlobalMap = InitializeMap(New System.Drawing.Size(CInt(imgMap.Width.Value), CInt(imgMap.Height.Value)))
If Page.IsPostBack Then
'Page is post back. Restore center and zoom-values from viewstate
smmGlobalMap.Center = DirectCast(ViewState("mapCenter"), SharpMap.Geometries.Point)
smmGlobalMap.Zoom = CDbl(ViewState("mapZoom"))
Else
'This is the initial view of the map. Zoom to the extents of the map:
smmGlobalMap.ZoomToExtents()
'Save the current mapcenter and zoom in the viewstate
ViewState.Add("mapCenter", smmGlobalMap.Center)
ViewState.Add("mapZoom", smmGlobalMap.Zoom)
'Create the map
CreateMap()
End If
DistanceAltstRebstein()
End Sub
Protected Sub imgMap_Click(ByVal sender As Object, ByVal e As ImageClickEventArgs)
'Set center of the map to where the client clicked
smmGlobalMap.Center = SharpMap.Utilities.Transform.MapToWorld(New System.Drawing.Point(e.X, e.Y), smmGlobalMap)
'Set zoom value if any of the zoom tools were selected
If rblMapTools.SelectedValue = "0" Then
'Zoom in
smmGlobalMap.Zoom = smmGlobalMap.Zoom * 0.5
ElseIf rblMapTools.SelectedValue = "1" Then
'Zoom out
smmGlobalMap.Zoom = smmGlobalMap.Zoom * 2
End If
'Save the new map's zoom and center in the viewstate
ViewState.Add("mapCenter", smmGlobalMap.Center)
ViewState.Add("mapZoom", smmGlobalMap.Zoom)
'Create the map
CreateMap()
Response.Write("X: " + e.X.ToString + " Y: " + e.Y.ToString + "<br /><br />")
Response.Write("Longitude: " + smmGlobalMap.Center.X.ToString + " Latitude: " + smmGlobalMap.Center.Y.ToString + "<br />")
End Sub
' http://sharpmapv2.googlecode.com/svn/trunk/SharpMap/Rendering/Thematics/CustomTheme.cs
Public Function SetStyle1(ByVal row As SharpMap.Data.FeatureDataRow) As SharpMap.Styles.VectorStyle
Dim vstlStyle1 As SharpMap.Styles.VectorStyle = New SharpMap.Styles.VectorStyle()
vstlStyle1.Enabled = True
vstlStyle1.EnableOutline = True
vstlStyle1.Fill = System.Drawing.Brushes.Yellow
Return vstlStyle1
End Function
'density, countryname
Private Sub InsertData(ByVal strParameter1 As String, ByVal strParameter2 As String)
Dim dbcon As New System.Data.SqlClient.SqlConnection("Data Source=pc-myname\MS_SQL_2005;Initial Catalog=ddb;Integrated Security=SSPI;")
dbcon.Open()
Dim strSQL As String = "IF NOT EXISTS (SELECT * FROM sys.objects WHERE object_id = OBJECT_ID(N'dbo.T_SHP_Country') AND type in (N'U'))"
strSQL += "CREATE TABLE T_SHP_Country( "
strSQL += "SHPC_UID uniqueidentifier NULL, "
strSQL += "SHPC_Density int NULL, "
strSQL += "SHPC_CountryName nvarchar(max) NULL "
strSQL += ") ON [PRIMARY] ;"
Dim dbcmdCheckRequirements As New System.Data.SqlClient.SqlCommand(strSQL, dbcon)
dbcmdCheckRequirements.ExecuteNonQuery()
'dbcmdCheckRequirements.CommandText = "DELETE FROM T_SHP_Country"
'dbcmdCheckRequirements.ExecuteNonQuery()
strParameter1 = strParameter1.Replace("'", "''")
strParameter2 = strParameter2.Replace("'", "''")
'strParameter3 = strParameter3.Replace("'", "''")
strSQL = "INSERT INTO T_SHP_Country "
strSQL += "(SHPC_UID, SHPC_Density, SHPC_CountryName)"
strSQL += "VALUES("
strSQL += "'" + System.Guid.NewGuid.ToString() + "', " 'PLZ_UID, uniqueidentifier
strSQL += " '" + strParameter1 + "', " 'PLZ_Name1, nvarchar(max)
strSQL += " '" + strParameter2 + "' " 'PLZ_State, nvarchar(max)
strSQL += ")"
Dim cmd As New System.Data.SqlClient.SqlCommand(strSQL, dbcon)
cmd.ExecuteNonQuery()
dbcon.Close()
End Sub
Public Function SetStyle(ByVal row As SharpMap.Data.FeatureDataRow) As SharpMap.Styles.VectorStyle
Response.Write("")
If False Then
For i As Integer = 0 To row.Table.Columns.Count - 1 Step 1
Response.Write("<br>" + row.Table.Columns(i).ColumnName + "<br>")
Response.Write("<br>" + row("NAME").ToString + ": " + row("POPDENS").ToString + "<br>")
Next i
End If
Try
'InsertData(row("POPDENS").ToString(), row("NAME").ToString())
Dim vstlStyle As SharpMap.Styles.VectorStyle = New SharpMap.Styles.VectorStyle()
Select Case row("POPDENS")
Case 0 To 5
' Add reference to System.Drawing
Dim colCustomColor As System.Drawing.Color = System.Drawing.Color.FromArgb(50, System.Drawing.Color.Gray)
'Dim customColor As System.Drawing.Color = System.Drawing.Color.FromArgb(255, 0, 110, 255)
Dim sbShadowBrush As System.Drawing.SolidBrush = New System.Drawing.SolidBrush(colCustomColor)
vstlStyle.Fill = sbShadowBrush
Case 6 To 9
vstlStyle.Fill = System.Drawing.Brushes.BlanchedAlmond
Case 10 To 25
vstlStyle.Fill = System.Drawing.Brushes.DarkGreen
Case 26 To 50
vstlStyle.Fill = System.Drawing.Brushes.Green
Case 51 To 100
vstlStyle.Fill = System.Drawing.Brushes.YellowGreen
Case 101 To 200
vstlStyle.Fill = System.Drawing.Brushes.Orange
Case 201 To 250
vstlStyle.Fill = System.Drawing.Brushes.DarkOrange
Case 251 To 300
vstlStyle.Fill = System.Drawing.Brushes.OrangeRed
Case 401 To 600
vstlStyle.Fill = System.Drawing.Brushes.Red
Case 601 To 900
vstlStyle.Fill = System.Drawing.Brushes.DarkRed
Case 901 To 1000
vstlStyle.Fill = System.Drawing.Brushes.Crimson
Case Else
vstlStyle.Fill = System.Drawing.Brushes.Pink
End Select
vstlStyle.EnableOutline = True
Dim clCustomPenColor As System.Drawing.Color = System.Drawing.Color.FromArgb(100, 100, 100, 100)
Dim myPen As New System.Drawing.Pen(clCustomPenColor)
myPen.Width = 0.1
'vstlStyle.Outline = System.Drawing.Pens.Black
vstlStyle.Outline = myPen
Return vstlStyle
'If (row("NAME").ToString().StartsWith("S")) Then
' Dim vstlStyle As SharpMap.Styles.VectorStyle = New SharpMap.Styles.VectorStyle()
' vstlStyle.Fill = System.Drawing.Brushes.Yellow
' Return vstlStyle
'Else
' Return Nothing ' Return null which will render the default style
'End If
Catch ex As Exception
Response.Write(ex.Message)
Return Nothing
End Try
End Function
Sub SetThemeForLayerOnMap(ByRef cstCustomTheme As SharpMap.Rendering.Thematics.CustomTheme, ByVal strLayerName As String, ByRef smmMapParameter As SharpMap.Map)
TryCast(smmMapParameter.GetLayerByName(strLayerName), SharpMap.Layers.VectorLayer).Theme = cstCustomTheme
'CType(smmMapParameter.GetLayerByName(strLayerName), SharpMap.Layers.VectorLayer).Theme = cstCustomTheme
End Sub
Sub ReIndex(ByVal strRelativePath As String)
Dim shfShapeFile As New SharpMap.Data.Providers.ShapeFile(Server.MapPath(strRelativePath), True)
ReIndex(shfShapeFile)
End Sub
Sub ReIndex(ByRef shfShapeFile As SharpMap.Data.Providers.ShapeFile)
If shfShapeFile.IsOpen Then
shfShapeFile.RebuildSpatialIndex()
Else
shfShapeFile.Open()
shfShapeFile.RebuildSpatialIndex()
shfShapeFile.Close()
End If
End Sub
Public Function OldDegreesToRadian(ByVal dblDegrees As Double) As Double
Dim dblRadians = dblDegrees * Math.PI / 180.0
Return dblRadians
End Function
Public Sub DistanceAltstRebstein()
'http://www.getlatlon.com/
Dim allat As Double = 47.377894
Dim allong As Double = 9.539833
Dim reblat As Double = 47.399364
Dim reblong As Double = 9.585995
Dim distance As Double = GetDistance(allat, reblat, allong, reblong)
Response.Write("Distance: " + distance.ToString("#,#.000") + " km")
End Sub
'http://www.codeproject.com/KB/cs/distancebetweenlocations.aspx
'http://www.billsternberger.net/asp-net-mvc/latitude-and-longitude-lookup-with-jquery-c-asp-net-mvc/
'http://webcache.googleusercontent.com/search?q=cache:y6AGC8J7zG8J:bryan.reynoldslive.com/post/Latitude2c-Longitude2c-Bearing2c-Cardinal-Direction2c-Distance2c-and-C.aspx+c%23+get+latitude+longitude&cd=2&hl=en&ct=clnk
Public Function GetDistance(ByVal dblLat1 As Double, ByVal dblLat2 As Double, ByVal dblLong1 As Double, ByVal dblLong2 As Double) As Double
' http://itouchmap.com/latlong.html
' http://mathforum.org/library/drmath/sets/select/dm_lat_long.html
' http://stevemorse.org/jcal/latlon.php
' http://en.wikipedia.org/wiki/Atan2
' http://www.movable-type.co.uk/scripts/latlong.html
' Formula:
' R = Earth's radius (mean radius = 6,371km)
' Δlat = lat2− lat1
' Δlong = long2− long1
' a = sin²(Δlat/2) + cos(lat1)*cos(lat2)*sin²(Δlong/2)
' c = 2*atan2(√a, √(1−a))
' d = R*c
dblLat1 = OldDegreesToRadian(dblLat1)
dblLat2 = OldDegreesToRadian(dblLat2)
dblLong1 = OldDegreesToRadian(dblLong1)
dblLong2 = OldDegreesToRadian(dblLong2)
'http://en.wikipedia.org/wiki/Earth_radius#Mean_radii
Dim dblEarthMeanRadius As Double = 6371.009 ' km
Dim dblHalfDeltaLat As Double = (dblLat2 - dblLat1) / 2.0
Dim dblHalfDeltaLong As Double = (dblLong2 - dblLong1) / 2.0
Dim dblTriangleSideA As Double = Math.Sin(dblHalfDeltaLat) * Math.Sin(dblHalfDeltaLat) + _
Math.Cos(dblLat1) * Math.Cos(dblLat2) * _
Math.Sin(dblHalfDeltaLong) * Math.Sin(dblHalfDeltaLong)
Dim dblTriangleSideC As Double = 2 * Math.Atan2(Math.Sqrt(dblTriangleSideA), Math.Sqrt(1 - dblTriangleSideA))
Dim dblDistance As Double = dblEarthMeanRadius * dblTriangleSideC ' in km
Return dblDistance ' in km
' Note for the English: 1 (statute) mile = 1609.344 m = 1.609344 km
' http://en.wikipedia.org/wiki/Mile#Nautical_mile
dblDistance = dblDistance / 1.609344 ' km to statute miles
Return dblDistance ' in statute miles
End Function
''' <summary>
''' Sets up the map, add layers and sets styles
''' </summary>
''' <param name="outputsize">Initiatial size of output image</param>
''' <returns>Map object</returns>
Private Function InitializeMap(ByVal outputsize As System.Drawing.Size) As SharpMap.Map
'Initialize a new map of size 'imagesize'
Dim map As New SharpMap.Map(outputsize)
map.BackColor = Drawing.Color.AliceBlue
'Set up the countries layer
Dim layCountries As New SharpMap.Layers.VectorLayer("Countries")
'Set the datasource to a shapefile in the App_data folder
Dim sfShapeFile1 As New SharpMap.Data.Providers.ShapeFile(Server.MapPath("~\App_data\Countries.shp"), True)
ReIndex(sfShapeFile1)
'Dim x As System.Data.DataColumnCollection = sfShapeFile1.Columns
'For Each y As DataColumn In x
' Response.Write(y.ColumnName)
' Response.Write(y.DataType.ToString())
'
' Next
'x.Item(0).ColumnName
'x.Item(0).DataType.ToString()
layCountries.DataSource = sfShapeFile1
'Set fill-style to green
Dim MyTheme As New SharpMap.Rendering.Thematics.CustomTheme(AddressOf SetStyle)
Dim defaultstyle As SharpMap.Styles.VectorStyle = New SharpMap.Styles.VectorStyle()
defaultstyle.Fill = System.Drawing.Brushes.Gray
MyTheme.DefaultStyle = defaultstyle
layCountries.Theme = MyTheme
layCountries.Style.Fill = New System.Drawing.SolidBrush(System.Drawing.Color.Green)
'Set the polygons to have a black outline
layCountries.Style.Outline = System.Drawing.Pens.Black
layCountries.Style.EnableOutline = True
'Set up a river layer
Dim layRivers As New SharpMap.Layers.VectorLayer("Rivers")
'Set the datasource to a shapefile in the App_data folder
Dim sh2 As New SharpMap.Data.Providers.ShapeFile(Server.MapPath("~\App_data\Rivers.shp"), True)
ReIndex(sh2)
layRivers.DataSource = sh2
'Define a blue 1px wide pen
layRivers.Style.Line = New System.Drawing.Pen(System.Drawing.Color.Blue, 1)
'Dim x As New SharpMap.Rendering.Thematics.IndividualTheme("abc")
'Add the layers to the map object.
'The order we add them in are the order they are drawn, so we add the rivers last to put them on top
map.Layers.Add(layCountries)
map.Layers.Add(layRivers)
Return map
End Function
''' <summary>
''' Creates the map, inserts it into the cache and sets the ImageButton Url
''' </summary>
Private Sub CreateMap()
If smmGlobalMap Is Nothing Then
Response.Write("<h1 style=""color: red;"">smmGlobalMap is NULL !</h1>")
Else
Dim img As System.Drawing.Image = smmGlobalMap.GetMap()
Dim imgID As String = SharpMap.Web.Caching.InsertIntoCache(1, img)
imgMap.ImageUrl = "getmap.aspx?ID=" & HttpUtility.UrlEncode(imgID)
End If
End Sub
End Class
' http://www.4guysfromrolla.com/articles/052610-1.aspx
' http://code.google.com/apis/maps/faq.html
' http://www.billsternberger.net/asp-net-mvc/latitude-and-longitude-lookup-with-jquery-c-asp-net-mvc/
' http://code.google.com/apis/maps/documentation/geocoding/
' http://code.google.com/apis/maps/documentation/geocoding/index.html
' http://code.google.com/apis/maps/faq.html#geocoder_countries
' http://maps.google.com/maps/api/geocode/json?address=1600+Amphitheatre+Parkway,+Mountain+View,+CA&sensor=false
' http://maps.google.com/maps/api/geocode/json?address=Zurich,+Switzerland&sensor=false
' http://maps.google.com/maps/api/geocode/json?address=SanBernardino,+Switzerland&sensor=false&output=json
' http://maps.google.com/maps/api/geocode/json?address=afsdfKarrrachiii&sensor=false&output=json
' http://math.rice.edu/~pcmi/sphere/sphere.html
' http://math.rice.edu/~pcmi/sphere/
Namespace Google.Maps.JSON
Public Class cAddressComponent
Public long_name
Public short_name
Public types As New List(Of String) '"locality", "country", "postal_code", "sublocality", administrative_area_level_1", administrative_area_level_2", "political"
End Class
Public Class cLocation
Public lat As Double = 0
Public lng As Double = 0
End Class
Public Class cViewPort
Public southwest As New cLocation
Public northeast As New cLocation
End Class
Public Class cBounds
Public southwest As New cLocation
Public northeast As New cLocation
End Class
Public Class cGeometry
Public location As New cLocation
Public location_type As String = "APPROXIMATE" ' "GEOMETRIC_CENTER",
Public viewport As New cViewPort
Public bounds As New cBounds
End Class
Public Class cResult
Public types As New List(Of String) ' "route", "point_of_interest", "establishment", "locality", "sublocality", "political"
Public formatted_address As String
Public address_components As New List(Of cAddressComponent)
Public geometry As New cGeometry
End Class
Public Class cGeoCodeResponse
Public status As String = "ZERO_RESULTS" ' "OK"
Public results As New List(Of cResult)
End Class
End Namespace

How to append new node to existing node in xml

Following is my xml file code
<XMLFile>
<EMail>
<From>
<Address>dddd#acd.com</Address>
</From>
<Receipent> <To>eeee#qwe.com</To> </Receipent>
<Subject>fffffsadasd</Subject>
<Body>ggggasdsd</Body>
</EMail>
</XMLFile>
i hve a sent button.On clicking that button each time i want to append Enail node and correponding childnodes to existing xml file.
In sent buttonclick i hve written following code.
Dim currNode As XmlNode
Dim doc As New XmlDocument
doc.LoadXml(("<XMLFile>" + " <EMail></EMail>" + "</XMLFile>"))
Dim docFrag As XmlDocumentFragment = doc.CreateDocumentFragment()
docFrag.InnerXml = "<From>" + " <Address>" + txtFrom.Text + " </Address>" + "</From>"
currNode = doc.DocumentElement.FirstChild
currNode.InsertAfter(docFrag, currNode.LastChild)
docFrag.InnerXml = "<Receipent>" + " <To>" + txtTo.Text + " </To>" + "</Receipent>"
currNode = doc.DocumentElement.FirstChild
currNode.InsertAfter(docFrag, currNode.LastChild)
docFrag.InnerXml = "<Subject>" + txtSubject.Text + "</Subject>"
currNode = doc.DocumentElement.FirstChild
currNode.InsertAfter(docFrag, currNode.LastChild)
docFrag.InnerXml = "<Body>" + txtBody.Text + "</Body>"
currNode = doc.DocumentElement.FirstChild
currNode.InsertAfter(docFrag, currNode.LastChild)
doc.Save("C:\xmlmailfile.xml")
What modification i have to make in button click
Something like this should do it. An XMLTextWriter might be better for your purposes though:
Private Function GenerateXML(ByVal emails As List(Of Email)) As String
Dim sb As New System.Text.StringBuilder
Using sw As New IO.StringWriter(sb), xt As New Xml.XmlTextWriter(sw)
xt.WriteStartElement("xmlDoc")
For i As Integer = 0 To emails.Count - 1
xt.WriteStartElement("email")
xt.WriteStartElement("From")
xt.WriteElementString("address", emails(i).From)
xt.WriteEndElement()
xt.WriteStartElement("Receipent")
xt.WriteElementString("to", emails(i).Recipient)
xt.WriteEndElement()
xt.WriteElementString("subject", emails(i).Subject)
xt.WriteElementString("body", emails(i).Body)
xt.WriteEndElement()
Next
xt.WriteEndElement()
End Using
Return sb.ToString
End Function
EDIT:
This need error handling etc, but should work for you. There are some cases where it will break (such as if a file exists but is empty) which you will need to solve yourself.
Module consoleTestApp
Private _path As String = "c:\output.xml"
//Just pretend these are text boxes
Public txtFrom As String
Public txtRecipient As String
Public txtSubject As String
Public txtBody As String
Sub Main()
txtFrom = "from1"
txtRecipient = "rec1"
txtSubject = "subj1"
txtBody = "body1"
AddNewEmail()
txtFrom = "from2"
txtRecipient = "rec2"
txtSubject = "subj2"
txtBody = "body2"
AddNewEmail()
End Sub
Private Sub AddNewEmail()
If Not IO.File.Exists(_path) Then
Using xt As New Xml.XmlTextWriter(_path, System.Text.Encoding.UTF8)
xt.WriteStartElement("xmlDoc")
xt.WriteEndElement()
End Using
End If
Dim xD As New Xml.XmlDocument
xD.Load(_path)
Dim xN As Xml.XmlNode = xD.CreateNode(Xml.XmlNodeType.Element, String.Empty, "email", String.Empty)
xN.InnerXml = GenerateXML()
xD.SelectSingleNode("//xmlDoc").AppendChild(xN)
xD.Save(_path)
End Sub
Private Function GenerateXML() As String
Dim sb As New System.Text.StringBuilder
Using sw As New IO.StringWriter(sb), xt As New Xml.XmlTextWriter(sw)
xt.WriteStartElement("From")
xt.WriteElementString("address", txtFrom)
xt.WriteEndElement()
xt.WriteStartElement("Receipent")
xt.WriteElementString("to", txtRecipient)
xt.WriteEndElement()
xt.WriteElementString("subject", txtSubject)
xt.WriteElementString("body", txtBody)
End Using
Return sb.ToString
End Function
End Module