Google-maps loads different location from marker - vb.net

My Google-maps api loads the map on the Atlantic-Ocean whilest my markers are pointed somewhere else.
I have checked my code, the lat and long coordinates are correct and they are marked on the map.
Can anybody help me out on this one?
Dim GeoLatitude As Double
Dim GeoLongitude As Double
Dim GoogleGeoCoderKey As String = keyvar
Dim GoogleResult1 As GoogleResult
GoogleResult1 = GoogleGeocoder.Geocode("streetname, PC City", GoogleGeoCoderKey) 'CurrentPage.PageName & " " & CurrentPage.BodyLeft
If GoogleResult1.Status = GeocodeStatus.G_GEO_SUCCESS Then
If GoogleResult1.Locations.Count = 1 Then
For Each loc As Location In GoogleResult1.Locations()
Dim latOld As String = loc.Point.Latitude.ToString()
GeoLatitude = loc.Point.Latitude ' latOld.Replace(",", ".")
Dim lonOld As String = loc.Point.Longitude.ToString()
GeoLongitude = loc.Point.Longitude 'lonOld.Replace(",", ".")
Next
End If
End If
GoogleMap1.Width = 628
GoogleMap1.Height = 300
GoogleMap1.GoogleKey = keyvar
GoogleMap1.Latitude = GeoLatitude
GoogleMap1.Longitude = GeoLongitude
GoogleMap1.Zoom = 15
GoogleMap1.Options.MapTypes.Add(New Reimers.Map.CustomMaps.GoogleNormalMap())
Dim tm As New Reimers.Map.CustomMaps.GoogleNormalMap()
GoogleMap1.DefaultMap() = tm
GoogleMap1.MapControls.Clear()
GoogleMap1.MapControls.Add(New Reimers.Map.Controls.GoogleLargeMapControl("smc"))
If SubPagePartValue.SmallText1 <> "" And SubPagePartValue.SmallText2 <> "" Then
GeoLatitude = CDbl(SubPagePartValue.SmallText1)
GeoLongitude = CDbl(SubPagePartValue.SmallText2)
End If
If GeoLatitude = 0 Or GeoLongitude = 0 Then
GoogleResult1 = GoogleGeocoder.Geocode(SubPages.BodyLeft, GoogleGeoCoderKey)
If GoogleResult1.Status = GeocodeStatus.G_GEO_SUCCESS Then
If GoogleResult1.Locations.Count = 1 Then
For Each loc As Location In GoogleResult1.Locations()
Dim latOld As String = loc.Point.Latitude.ToString()
GeoLatitude = loc.Point.Latitude
Dim lonOld As String = loc.Point.Longitude.ToString()
GeoLongitude = loc.Point.Longitude
SubPagePartValue.SmallText1 = GeoLatitude
SubPagePartValue.SmallText2 = GeoLongitude
SubPagePartValue.Save()
Next
End If
End If
End If
Dim HTMLCode As String
Dim gm As GoogleMarker = New GoogleMarker(SubPages.PageID)
gm.Point.Latitude = GeoLatitude
gm.Point.Longitude = GeoLongitude
HTMLCode = "<div class=""GoogleMapsPopUp""><h1 class=""GoogleMapsPopUp"">" & SubPages.PageName & "</h1>"
HTMLCode = HTMLCode & "<p class=""text"">" & SubPages.PageName & "</p><p>" & SubPages.BodyLeft & "</p></div>"
gm.MarkerText = HTMLCode
gm.ClientSideHandlers.OnInfoWindowOpen = GoogleMap1.PanTo(gm.Point)
gm.ClientSideHandlers.OnClick = gm.OpenInfoWindowHTML(GoogleMap1, gm.MarkerText)
'gm.Options.Icon = SailpointIcon
gm.Options.Title = Replace(SubPages.PageName, "'", "")
GoogleMap1.Overlays.Add(gm)
End If
Next
the actual result can be viewed on the following site: http://www.stripdagenhaarlem.nl/Programma-Stripdagen-Haarlem.html?cb=T If you zoom out on the maps you would see that the markers are placed correct. However, the map keeps zooming on the wrong location.

Try and load your variables to make the code look like
<html xmlns=http://www.w3.org/1999/xhtml><head><meta http-equiv=Content-Type content=text/html; charset=utf-8 /><body topmargin=0 leftmargin=0 ><iframe width=574 height=275 frameborder=0 scrolling=no marginheight=0 marginwidth=0 src=https://maps.google.com/maps?hl=en&ie=UTF8&ll=" & GLLat & "," & GLLong & "&spn=0.819443,1.454315&t=h&z=18&output=embed></iframe></body></html>
Make sure scrolling=no and z=18, z is the zoom where it initially starts out at
You will have to piece your variables together yourself :P
hope this helps

Related

The copy process is very slow with this function vb.net

I use this function for copying some files from the Source folder to the Destination folder, but the copying is needed more time than usual.
Sub SyncFiles(Lbl_Percentage As Label, Lbl_FileName As Label, PrgrsBar As ProgressBar)
Try
Dim Sql As String = "SELECT GroupID FROM Tbl_Current"
Dim GetGroupID = MsAcc_RetriveTemp(Sql, 0)
Dim Sql1 As String = "Select * FROM Tbl_SyncPath where ID=" & GetGroupID
Dim Src As String = MsAcc_RetriveTemp(Sql1, 1)
Dim Des As String = MsAcc_RetriveTemp(Sql1, 2)
If Not IO.Directory.Exists(Des) Then IO.Directory.CreateDirectory(Des)
Dim fls() As String = IO.Directory.GetFiles(Des)
PrgrsBar.Value = 0
PrgrsBar.Maximum = fls.Count
For Each fn As String In fls
Dim filename As String = IO.Path.GetFileName(fn)
My.Computer.FileSystem.CopyDirectory(Des, Src, True)
PrgrsBar.Value += 1 'add 1 to the ProgressBar`s value
Dim Percntge As Integer = (PrgrsBar.Value / fls.Count) * 100
Lbl_Percentage.Text = Percntge & " %"
Lbl_FileName.Text = "جاري تحديث ملف: " & filename
Application.DoEvents()
Lbl_FileName.Text = "اكتمل عملية التحديث."
Next
Catch ex As Exception
End Try
End Sub
You copy all the files in the folder for each files.
For Each fn As String In fls
Dim filename As String = IO.Path.GetFileName(fn)
My.Computer.FileSystem.CopyDirectory(Des, Src, True) ' <--- No file specified
PrgrsBar.Value += 1 'add 1 to the ProgressBar`s value
Dim Percntge As Integer = (PrgrsBar.Value / fls.Count) * 100
Lbl_Percentage.Text = Percntge & " %"
Lbl_FileName.Text = "جاري تحديث ملف: " & filename
Application.DoEvents()
Lbl_FileName.Text = "اكتمل عملية التحديث."
Next
Put this outside the loop
My.Computer.FileSystem.CopyDirectory(Des, Src, True)
For Each fn As String In fls
' ...
Next
Also, seems like des and src are mixed up.

Crystal Reports Missing Parameter Values

I am running the version of crystal that comes with Visual Studio 2010. I have a report that has three sub reports. There are parameters that are passed from the main report to the sub-reports. I am able to run the report in the development environment by clicking on Main Report Preview.
The problem is when I try to execute it at run time. I get the error “Missing parameter values”. I need some hints as to how to debug this problem. The error doesn’t tell you which parameter is the problem or which sub-report is involved.
Any hint will be appreciated.
I am editing this to respond to some of the questions. I am using subreports links which is where I think the problem might be. In the pass by fiddling with the settings I was able to get it to work. It seems like it was just trial and error.
I am posting a portion of the code here based on the request in the comments
Public Function GetReportOutput(iDatabaseIndicator As eDatabaseIndicatorEnum, ReportName As String, ReportOutputtype As eReportOutputtype, ReportParameters As System.Collections.Generic.List(Of clsReportParam)) As clsReturn Implements IsvcEDReports.GetReportOutput
Dim l_crRep As New CrystalDecisions.CrystalReports.Engine.ReportDocument
Dim l_clsReturn As clsReturn = New clsReturn
Dim l_ExportFormatType As ExportFormatType
Dim l_strReport As String = ""
Dim l_strReportName As String = ""
Dim l_strOutputFile As String = ""
Dim l_strFullPathName As String = ""
Dim l_strReportOutputPath As String = ConfigurationManager.AppSettings.Get(IIf(ConfigurationManager.AppSettings.Get("Environment") = 1, "ReportOutputPath_Dev", "ReportOutputPath_Prod"))
Dim l_strReportPath As String = ConfigurationManager.AppSettings.Get(IIf(ConfigurationManager.AppSettings.Get("Environment") = 1, "ReportPath_Dev", "ReportPath_Prod"))
Dim l_udtReport As CrystalDecisions.CrystalReports.Engine.ReportDocument = Nothing
Dim l_intCount As Integer = 0
Dim l_fsReturn As FileStream = Nothing
Dim l_binFilestream As BinaryReader = Nothing
Dim l_bytFile As Byte() = Nothing
Dim l_expOptions As New CrystalDecisions.Shared.ExportOptions
Dim l_expExcFmtOptions As New CrystalDecisions.Shared.ExcelFormatOptions
Dim l_tblParameters As New DataTable("Parameters")
Dim l_aryParams(1)
Dim udtSubReport As ReportDocument
Dim udtSubReportOpened As ReportDocument
Try
iDatabaseIndicator = iDatabaseIndicator
InitDataController(iDatabaseIndicator)
m_strReport = (l_strReportPath & "\" & ReportName)
l_strReportName = ReportName
l_strReport = m_strReport
l_strOutputFile = Regex.Replace(ReportName, " ", "_") & "_" & Format(Now(), "MMddyyyy_hhmmss")
m_strOutputFilename = l_strOutputFile
With l_crRep
.Load(l_strReport, CrystalDecisions.Shared.OpenReportMethod.OpenReportByDefault)
If .IsLoaded Then
For Each udtSubReport In .Subreports
udtSubReportOpened = .OpenSubreport(udtSubReport.Name)
SetDatabase(udtSubReportOpened, False)
SetParameters(udtSubReportOpened, ReportParameters, False)
Next
SetDatabase(l_crRep)
SetParameters(l_crRep, ReportParameters)
Select Case ReportOutputtype
'Case eReportOutputtype.rptOutputType_RPT
' l_strOutputFile = l_strOutputFile & ".rpt"
' l_ExportFormatType = ExportFormatType.CrystalReport
Case eReportOutputtype.rptOutputType_XLS
l_strOutputFile = l_strOutputFile & ".xls"
'ReportOutputFile = ReportOutputFile & ".xls"
With l_expExcFmtOptions
.ExcelConstantColumnWidth = 125
.ExcelUseConstantColumnWidth = True
End With
With l_expOptions
.ExportFormatOptions = l_expExcFmtOptions
End With
l_ExportFormatType = ExportFormatType.Excel
Case eReportOutputtype.rptOutputType_PDF
l_strOutputFile = l_strOutputFile & ".pdf"
' ReportOutputFile = ReportOutputFile & ".pdf"
l_ExportFormatType = ExportFormatType.PortableDocFormat
Case eReportOutputtype.rptOutputType_DOC
l_strOutputFile = l_strOutputFile & ".doc"
' ReportOutputFile = ReportOutputFile & ".doc"
l_ExportFormatType = ExportFormatType.WordForWindows
Case eReportOutputtype.rptOutputType_CSV
l_strOutputFile = l_strOutputFile & ".csv"
' ReportOutputFile = ReportOutputFile & ".csv"
l_ExportFormatType = ExportFormatType.CharacterSeparatedValues
Case eReportOutputtype.rptOutputType_TXT
l_strOutputFile = l_strOutputFile & ".txt"
' ReportOutputFile = ReportOutputFile & ".txt"
l_ExportFormatType = ExportFormatType.Text
Case eReportOutputtype.rptOutputType_XML
l_strOutputFile = l_strOutputFile & ".xml"
' ReportOutputFile = ReportOutputFile & ".xml"
l_ExportFormatType = ExportFormatType.Xml
End Select
.ExportToDisk(l_ExportFormatType, l_strReportOutputPath & "\" & l_strOutputFile)
It crashes on the last line .ExportToDisk ...
I solved this problem, It was the hint from heringer that gave me the clue. I am passing 6 parameters to the main report but two of them are only used by the a sub-report not the main reports itself. I was defining these without the leading "#". I figured this out by display the parameters as I passed them in my code.
I was also able to look at an old report that was working and saw that I needed the at signs.
Bob

Chinese filename as an attachment in email

Following is simple code to send the mail with an attachment:
/**************************************************/
Dim msgMail As New System.Web.Mail.MailMessage
Dim rcpName As String
Dim client As New SmtpClient
Dim i As Integer
Dim recips_addr() As String = Split(to_address, ";")
Dim recips_name() As String = Split(to_name, ";")
For i = 0 To recips_addr.Length - 1
rcpName = """" & recips_name(i) & """"
msgMail.To = rcpName & recips_addr(i) & ";"
Next
msgMail.From = from_address
msgMail.Subject = subject
msgMail.BodyFormat = System.Web.Mail.MailFormat.Html
msgMail.Body = message
msgMail.BodyEncoding = System.Text.Encoding.UTF8
If String.IsNullOrEmpty(attachment_path) Then attachment_path = "NONE"
If (attachment_path <> "NONE") Then
Dim att As New System.Web.Mail.MailAttachment(attachment_path)
msgMail.Attachments.Add(att)
End If
If send_to_sender Then
msgMail.Bcc = from_address
End If
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserver") = My.Settings.smtp_Server
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 465
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/smtpusessl") = True
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/sendusername") = My.Settings.emailUsername
msgMail.Fields("http://schemas.microsoft.com/cdo/configuration/sendpassword") = My.Settings.emailPassword
System.Web.Mail.SmtpMail.Send(msgMail)
/**************************************************/
Now, the query is when i send a pdf file as an attachment using above code and file name is 'Report_出生地_出生地_出生地_6023.pdf'.
when i get the mail in my inbox the name of the file becomes 'Report____6023.pdf'.
I don't know why attachment filenames are changing.
Please help !!!!

dynamic table and button creation in asp.net

I have created a dynamic table using for loop condition.In which it has a button while i click a specific button it should open a file.But in my coding it is opening a file button in the last row.
If Not IsPostBack Then
txtlogsdate.Text = FormatDate(Now)
End If
Try
trViewlogs.Visible = True
lbllogs.Visible = False
lbllogname.Visible = True
RT1.Visible = False
pb.Visible = False
Dim d1 As DateTime = txtlogsdate.Text
Dim dd As String = d1.ToString("dd")
Dim mm As String = d1.ToString("MM")
Dim yy As String = d1.ToString("yy")
Dim d2 As String = yy & "" & mm & "" & dd
Dim di As DirectoryInfo = New DirectoryInfo(Server.MapPath("~\logs"))
Dim files As FileInfo() = di.GetFiles("*.log")
Dim tab As New Table()
tab.CellPadding = 0
tab.CellSpacing = 0
tab.BorderStyle = BorderStyle.Double
tab.Attributes.Add("style", "margin-left: 0.5px; width: 800px;")
Dim row As New TableRow()
Dim headerCell1 As New TableHeaderCell()
headerCell1.Text = "Logs"
headerCell1.Attributes.Add("style", "margin-left: 0.5px; height: 20px;")
headerCell1.BackColor = System.Drawing.Color.CornflowerBlue
headerCell1.ForeColor = System.Drawing.Color.White
row.Controls.Add(headerCell1)
tab.Controls.Add(row)
Dim headerCell2 = New TableHeaderCell()
headerCell2.Attributes.Add("style", "margin-left: 0.5px; height: 20px;")
headerCell2.BackColor = System.Drawing.Color.CornflowerBlue
headerCell2.ForeColor = System.Drawing.Color.White
headerCell2.Text = "Download"
row.Controls.Add(headerCell2)
tab.Controls.Add(row)
For i As Integer = 0 To files.Length - 1
Dim a As String = files(i).ToString.Replace("Event-", "")
Dim c As String = a.Substring(0, 6)
Dim sw As String
If d2 = c Then
sw = My.Computer.FileSystem.ReadAllText(_
GetWebSitePhysicalRoot & "\logs\" & files(i).ToString)
lbllogname.Text = files(i).ToString
lbllogname.Visible = False
row = New TableRow()
If i Mod 2 = 0 Then
row.BackColor = System.Drawing.Color.White
Else
row.BackColor = System.Drawing.Color.AliceBlue
End If
Dim cell As New TableCell()
cell.Text = lbllogname.Text
'cell.Width = New Unit("1000px")
cell.HorizontalAlign = HorizontalAlign.Center
row.Controls.Add(cell)
Dim cell2 As New TableCell()
Dim bt As New Button
bt.BorderStyle = BorderStyle.Solid
bt.Text = files(i).ToString
AddHandler bt.Click, AddressOf bt_Click
cell2.HorizontalAlign = HorizontalAlign.Center
cell2.Controls.Add(bt)
row.Controls.Add(cell2)
tab.Controls.Add(row)
Panel1.Controls.Add(tab)
End If
Next i
If lbllogname.Text = "" Then
lbllogname.Text = "No Logs to Display !"
End If
Session("pageurl") = ""
Session("pagecount") = ""
ib.SetInfo("Reports > View Logs", Infobar.InfoTypes.Caption)
Dim mi As Integer = GetQueryStringToInt("menuindex", 1)
If Not IsPostBack Then
leftmenu1.AddItem("View Logs", _
GetWebSiteUrlRoot & "/staff_rpt.aspx?rpt=logs&page=1&menuindex=" & mi)
End If
Catch ex As Exception
WriteLog(LogWriter.EventType.eError, ex.StackTrace.ToString)
End Try
Protected Sub bt_Click(ByVal sender As System.Object, _
ByVal e As System.EventArgs
Dim a As String
a = lbllogname.Text
Response.ContentType = "text/plain"
Response.AppendHeader("Content-Disposition", "attachment; filename=" & a)
Response.TransmitFile(Server.MapPath("~/logs/" & a))
Response.End()
End Sub
To use the dynamic table structure you have built in your code, then you need to uniquely name each button in each row; otherwise the button click handler (bt_Click) cannot figure out the correct row to open the file in, because they are all called the same and will use the last one.
Since you want a table structure, then I suggest you use the GridView server control, as it will provide similar output, but provide the ability to use templating to name the controls of each row the same, but allow for you to differentiate individual rows when a click event happens.

Add a Parameter Value in SSRS

I have a report already setup on the ReportServer. And its subscription as well. What I'm trying to do is add the ParameterValue "CC" and some email addresses then send the email out. It doesn't seem to work.
My code:
Dim emailReader As SqlDataReader = selCount.ExecuteReader
Dim emailsTest As List(Of String) = New List(Of String)
emailsTest.Add("test1#pen.com")
emailsTest.Add("test2#pen.com")
emailsTest.Add("test3#pen.com")
emailsTest.Add("test4#pen.com")
If emailReader.HasRows() Then 'checks to see if there any quotes in query
For Each subscrp As rs.Subscription In subscr
Dim allValues = subscrp.DeliverySettings.ParameterValues
Dim allValuesList As List(Of ReportTriggerTemplate1.rs.ParameterValueOrFieldReference) = allValues.ToList()
Dim CCParameter As ReportTriggerTemplate1.rs.ParameterValue = New ReportTriggerTemplate1.rs.ParameterValue()
CCParameter.Name = "CC"
CCParameter.Value = String.Empty
allValuesList.Add(CCParameter)
Dim toValue = CType(allValuesList.Item(7), ReportTriggerTemplate1.rs.ParameterValue)
For Each testEmail As String In emailsTest
Dim ownerEmail As String = testEmail
If toValue.Value.Contains(ownerEmail) Then
'skip
ElseIf toValue.Value = String.Empty Then
toValue.Value += ownerEmail
Else
toValue.Value += "; " & ownerEmail
End If
Next
subscrp.DeliverySettings.ParameterValues = allValuesList.ToArray()
Dim hello As String = "hi"
tr.FireEvent(EventType, subscrp.SubscriptionID) 'forces subscription to be sent
Next
What I'm adding to toValue.Value doesn't seem to be adding to the report's CC subscription field at all. So what am I missing?
http://msdn.microsoft.com/en-us/library/ms154020%28v=SQL.100%29.aspx
http://msdn.microsoft.com/en-us/library/reportservice2005.reportingservice2005.getsubscriptionproperties.aspx
http://msdn.microsoft.com/en-us/library/reportservice2005.reportingservice2005.setsubscriptionproperties%28v=SQL.105%29.aspx
Try
tr = New rs.ReportingService2005
Dim extSettings As ExtensionSettings = Nothing
Dim desc As String = Nothing
Dim active As ActiveState = Nothing
Dim status As String = Nothing
Dim matchData As String = Nothing
Dim values As ParameterValue() = Nothing
Dim extensionParams As ParameterValueOrFieldReference() = Nothing
Dim mainLogin As System.Net.NetworkCredential = New System.Net.NetworkCredential("ADUser", "Password", "NetworkName")
If mainLogin Is Nothing Then
tr.Credentials = System.Net.CredentialCache.DefaultCredentials
Else
tr.Credentials = mainLogin
End If
'skip to relevant code
For Each subscrp As rs.Subscription In subscr
Dim allValues = subscrp.DeliverySettings.ParameterValues
Dim allValuesList As List(Of ReportTriggerTemplate1.rs.ParameterValueOrFieldReference) = allValues.ToList()
If CType(allValuesList.Item(0), ReportTriggerTemplate1.rs.ParameterValue).Value = "test#pen.com" Then
Dim subsID = subscrp.SubscriptionID
'important code just below
tr.GetSubscriptionProperties(subsID, extSettings, desc, active, status, EventType, matchData, extensionParams)
''''add change to CC here
Dim extSettingsList As List(Of ReportTriggerTemplate1.rs.ParameterValueOrFieldReference) = extSettings.ParameterValues.ToList()
If CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Name = "CC" Then
If CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Value = String.Empty Then
CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Value = emailsTest.Item(0) & ";" & emailsTest.Item(1)
Else
CType(extSettingsList.Item(1), ReportTriggerTemplate1.rs.ParameterValue).Value += ";" & emailsTest.Item(0) & ";" & emailsTest.Item(1)
End If
Else
Dim CCParameter As ReportTriggerTemplate1.rs.ParameterValue = New ReportTriggerTemplate1.rs.ParameterValue()
CCParameter.Name = "CC"
CCParameter.Value = emailsTest.Item(0) & ";" & emailsTest.Item(1)
extSettingsList.Insert(1, CCParameter)
extSettings.ParameterValues = extSettingsList.ToArray
End If
'important code just below
tr.SetSubscriptionProperties(subsID, extSettings, desc, EventType, matchData, extensionParams)
tr.FireEvent(EventType, subscrp.SubscriptionID) 'forces subscription to be sent
Else
End If
Next