Permet d'ajouter automatiquement des clients dans la base de données (ou dans un fichier) de Fleet Manager après avoir effectuer une geo localisation avec Map Point 2004.
Calcul de latitude/longitude dans Map Point.
Source commentée.
Source / Exemple :
Imports System.Math 'Pour les fonctions mathématiques
Imports System.IO 'Pour les fonctions Entrées/Sorties (fichier)
Imports System.Data.SqlClient 'Pour l'accès à la base de données
Public Class Form1
Inherits System.Windows.Forms.Form
#Region " Code généré par le Concepteur Windows Form "
Public Sub New()
MyBase.New()
'Cet appel est requis par le Concepteur Windows Form.
InitializeComponent()
'Ajoutez une initialisation quelconque après l'appel InitializeComponent()
End Sub
'La méthode substituée Dispose du formulaire pour nettoyer la liste des composants.
Protected Overloads Overrides Sub Dispose(ByVal disposing As Boolean)
If disposing Then
If Not (components Is Nothing) Then
components.Dispose()
End If
End If
MyBase.Dispose(disposing)
End Sub
'Requis par le Concepteur Windows Form
Private components As System.ComponentModel.IContainer
'REMARQUE : la procédure suivante est requise par le Concepteur Windows Form
'Elle peut être modifiée en utilisant le Concepteur Windows Form.
'Ne la modifiez pas en utilisant l'éditeur de code.
Friend WithEvents RadioButtonFichierCSV As System.Windows.Forms.RadioButton
Friend WithEvents RadioButtonBD As System.Windows.Forms.RadioButton
Friend WithEvents GroupBox1 As System.Windows.Forms.GroupBox
Friend WithEvents ButtonQuitter As System.Windows.Forms.Button
Friend WithEvents BarreProgression As System.Windows.Forms.ProgressBar
Friend WithEvents ButtonGo As System.Windows.Forms.Button
Friend WithEvents ButtonAide As System.Windows.Forms.Button
<System.Diagnostics.DebuggerStepThrough()> Private Sub InitializeComponent()
Dim resources As System.Resources.ResourceManager = New System.Resources.ResourceManager(GetType(Form1))
Me.ButtonGo = New System.Windows.Forms.Button
Me.RadioButtonFichierCSV = New System.Windows.Forms.RadioButton
Me.RadioButtonBD = New System.Windows.Forms.RadioButton
Me.GroupBox1 = New System.Windows.Forms.GroupBox
Me.ButtonQuitter = New System.Windows.Forms.Button
Me.BarreProgression = New System.Windows.Forms.ProgressBar
Me.ButtonAide = New System.Windows.Forms.Button
Me.GroupBox1.SuspendLayout()
Me.SuspendLayout()
'
'ButtonGo
'
Me.ButtonGo.Location = New System.Drawing.Point(48, 192)
Me.ButtonGo.Name = "ButtonGo"
Me.ButtonGo.Size = New System.Drawing.Size(88, 24)
Me.ButtonGo.TabIndex = 0
Me.ButtonGo.Text = "Go !"
'
'RadioButtonFichierCSV
'
Me.RadioButtonFichierCSV.Checked = True
Me.RadioButtonFichierCSV.Location = New System.Drawing.Point(8, 24)
Me.RadioButtonFichierCSV.Name = "RadioButtonFichierCSV"
Me.RadioButtonFichierCSV.Size = New System.Drawing.Size(200, 16)
Me.RadioButtonFichierCSV.TabIndex = 1
Me.RadioButtonFichierCSV.TabStop = True
Me.RadioButtonFichierCSV.Text = "Fichier *.CSV"
'
'RadioButtonBD
'
Me.RadioButtonBD.Location = New System.Drawing.Point(8, 48)
Me.RadioButtonBD.Name = "RadioButtonBD"
Me.RadioButtonBD.Size = New System.Drawing.Size(208, 16)
Me.RadioButtonBD.TabIndex = 2
Me.RadioButtonBD.Text = "Base de données de Fleet Manager"
'
'GroupBox1
'
Me.GroupBox1.Controls.Add(Me.RadioButtonFichierCSV)
Me.GroupBox1.Controls.Add(Me.RadioButtonBD)
Me.GroupBox1.Location = New System.Drawing.Point(32, 24)
Me.GroupBox1.Name = "GroupBox1"
Me.GroupBox1.Size = New System.Drawing.Size(232, 80)
Me.GroupBox1.TabIndex = 3
Me.GroupBox1.TabStop = False
Me.GroupBox1.Text = "Sortie vers"
'
'ButtonQuitter
'
Me.ButtonQuitter.Location = New System.Drawing.Point(160, 192)
Me.ButtonQuitter.Name = "ButtonQuitter"
Me.ButtonQuitter.Size = New System.Drawing.Size(88, 24)
Me.ButtonQuitter.TabIndex = 4
Me.ButtonQuitter.Text = "Quitter"
'
'BarreProgression
'
Me.BarreProgression.Location = New System.Drawing.Point(24, 144)
Me.BarreProgression.Name = "BarreProgression"
Me.BarreProgression.Size = New System.Drawing.Size(240, 16)
Me.BarreProgression.TabIndex = 5
Me.BarreProgression.Visible = False
'
'ButtonAide
'
Me.ButtonAide.Location = New System.Drawing.Point(112, 232)
Me.ButtonAide.Name = "ButtonAide"
Me.ButtonAide.TabIndex = 6
Me.ButtonAide.Text = "A Propos"
'
'Form1
'
Me.AutoScaleBaseSize = New System.Drawing.Size(5, 13)
Me.ClientSize = New System.Drawing.Size(292, 266)
Me.Controls.Add(Me.ButtonAide)
Me.Controls.Add(Me.BarreProgression)
Me.Controls.Add(Me.ButtonQuitter)
Me.Controls.Add(Me.GroupBox1)
Me.Controls.Add(Me.ButtonGo)
Me.Icon = CType(resources.GetObject("$this.Icon"), System.Drawing.Icon)
Me.Name = "Form1"
Me.Text = "Localisation GPS des clients"
Me.GroupBox1.ResumeLayout(False)
Me.ResumeLayout(False)
End Sub
#End Region
'*************************************************
'*************** Déclarations ******************
'*************************************************
Dim MPAppEur As MapPoint.Application
Dim objMap As MapPoint.Map
Dim objDS As MapPoint.DataSet
Dim objRecordSet As MapPoint.Recordset
Dim objField As MapPoint.Field
Dim sw As StreamWriter
Dim Connexion As SqlClient.SqlConnection
'*****************************************************************
'****** Sub CalcPos : Retourne la latitude et la longitude *****
'****** à partir d'une localisation dans Map Point et ***********
'****** appelle la fonction d'écriture des données *************
'*****************************************************************
'****** Entrées : Carte MapPoint, Location, NomClient, RueClient,
'****** Compteur
'*****************************************************************
' Author: Gilles Kohl
'
' This code is copyrighted freeware - use freely, but please leave this ' header intact.
Sub CalcPos(ByVal objMap As MapPoint.Map, ByVal locX As MapPoint.Location, _
ByVal NomClient As String, ByVal RueClient As MapPoint.StreetAddress, _
ByVal Compteur As Integer)
Static locNorthPole As MapPoint.Location
Static locSantaCruz As MapPoint.Location ' Center of western hemisphere
Static dblHalfEarth As Double ' Half circumference of the earth (as a sphere)
Static dblQuarterEarth As Double ' Quarter circumference of the earth (as a sphere)
Static Pi As Double
Dim dbllat, dblLon As Double
' Si l'initialisation n'est pas encore effectuée
If locNorthPole Is Nothing Then
locNorthPole = objMap.GetLocation(90, 0)
locSantaCruz = objMap.GetLocation(0, -90)
' Calcule la distance entre le pole Nord et le pole sud == la moitié de la circonférence de la Terre
dblHalfEarth = objMap.Distance(locNorthPole, objMap.GetLocation(-90, 0))
' Le quart est la distance max qu'un point peut avoir avec locSantaCruz et rester dans : western hemisphere
dblQuarterEarth = dblHalfEarth / 2
Pi = 3.14159265358979
End If
' Calcule la latitude à partir du pôle Nord
dbllat = 90 - 180 * objMap.Distance(locNorthPole, locX) / dblHalfEarth
Dim l As Double
Dim d As Double
' Compute great circle distance to locX from point on Greenwich meridian and computed Latitude
d = objMap.Distance(objMap.GetLocation(dbllat, 0), locX)
' convert latitude to radian
l = (dbllat / 180) * Pi
' Compute Longitude from great circle distance
dblLon = 180 * Acos((Cos((d * 2 * Pi) / (2 * dblHalfEarth)) - Sin(l) * Sin(l)) / (Cos(l) * Cos(l))) / Pi
' Correct longitude sign if located in western hemisphere
If objMap.Distance(locSantaCruz, locX) < dblQuarterEarth Then dblLon = -dblLon
'Ecriture des données
If (RadioButtonFichierCSV.Checked = True) Then
EcrireFichier(NomClient, RueClient, Compteur, dbllat, dblLon)
Else
EcrireBD(NomClient, RueClient, dbllat, dblLon)
End If
End Sub
Private Sub ButtonGo_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonGo.Click
Dim latitude, longitude As Double
If (RadioButtonFichierCSV.Checked = True) Then
Dim FileSaveAs As New SaveFileDialog
FileSaveAs.Filter = "Fichier CSV (*.csv)|*.csv"
If FileSaveAs.ShowDialog() = DialogResult.OK Then
'Créer le lien vers le fichier
sw = New StreamWriter(FileSaveAs.FileName)
sw.WriteLine("""LocationID"",""LocationName"",""Details"",""LocationType"",""ShapeType"",""PointLongitude"",""PointLatitude"",""PointRadius"",""UpperLeftLongitude"",""UpperLeftLatitude"",""LowerRightLongitude"",""LowerRightLatitude""")
End If
Else
'Connexion à la base de données de FleetManager
Connexion = OuvrirConnexionBD()
End If
MPAppEur = CreateObject("MapPoint.Application.EU.11")
'Configure l'application
'***********************
'Rend l'appli non visible
MPAppEur.Visible = True
'Ne donne pas le contrôle à l'utilisateur
MPAppEur.UserControl = True
objMap = MPAppEur.ActiveMap
With MPAppEur.ActiveMap.DataSets
objDS = .ShowImportWizard
End With
'Extrait tous les enregistrements
objRecordSet = objDS.QueryAllRecords
objRecordSet.MoveFirst()
BarreProgression.Visible = True
BarreProgression.Maximum = objRecordSet.Fields.Count
BarreProgression.Step = 1
BarreProgression.Value = 1
BarreProgression.Minimum = 1
MPAppEur.Visible = False
Dim i As Integer
i = 1
Do Until objRecordSet.EOF
CalcPos(objMap, objRecordSet.Location, _
objRecordSet.Location.Name, objRecordSet.Location.StreetAddress, i)
objRecordSet.MoveNext()
i = i + 1
BarreProgression.PerformStep()
Loop
BarreProgression.Visible = False
MsgBox("Traitement terminé !!! ;-)")
End Sub
Public Function OuvrirConnexionBD() As SqlConnection
'********************************************
'***** Connexion a la base de données *****
'********************************************
Dim myConnection As SqlClient.SqlConnection = _
New SqlConnection("Persist Security Info=False;User ID=sa;Initial Catalog=FleetManager;Data Source=(local);Packet Size=4096;Workstation ID=PC22")
myConnection.Open()
If myConnection.State <> ConnectionState.Open Then
MsgBox("Erreur de connexion à la base de donnée de Fleet Manager")
End
End If
Return myConnection
End Function
Private Sub ButtonQuitter_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonQuitter.Click
If (RadioButtonFichierCSV.Checked = True) Then
Try
'Ferme le flux du fichier
sw.Close()
Catch ex As Exception
End Try
Else
Try
'Ferme la connexion avec la base de données
Connexion.Close()
Catch ex As Exception
End Try
End If
Try
'Quitte l'application Map Point
MPAppEur.Quit()
Catch ex As Exception
End Try
End
End Sub
Private Sub EcrireFichier(ByVal NomClient As String, ByVal AdresseClient As MapPoint.StreetAddress, _
ByVal Compteur As Integer, ByVal latitude As Double, ByVal longitude As Double)
Dim latitude2, longitude2 As String
'Mise en forme de latitude et longitude pour écriture dans le fichier
latitude2 = CStr(latitude).Replace(",", "|")
longitude2 = CStr(longitude).Replace(",", "|")
'Ecriture dans le fichier des informations
If AdresseClient Is Nothing Then
sw.WriteLine(Compteur & ",""" & NomClient & """,""" & """" & ";"",1,0," & """" & _
longitude2 & """,""" & latitude2 & """,""50"",""0"",""0"",""0"",""0""")
Else
sw.WriteLine(Compteur & ",""" & NomClient & """,""Street=" & CStr(AdresseClient.Street) & _
" ;City=" & CStr(AdresseClient.City) & " ;Zip=" & CStr(AdresseClient.PostalCode) & _
" ;Country=France" & ";"",1,0," & """" & _
longitude2 & """,""" & latitude2 & """,""50"",""0"",""0"",""0"",""0""")
End If
End Sub
Private Sub EcrireBD(ByVal NomClient As String, ByVal AdresseClient As MapPoint.StreetAddress, _
ByVal latitude As Double, ByVal longitude As Double)
Dim mySelectQuery As String = "SELECT sLocationName FROM MapLocations"
Dim Command As New SqlCommand(mySelectQuery, Connexion)
Dim myReader As SqlDataReader = Command.ExecuteReader()
Dim ClientArray As New ArrayList
'Suppression des caractères , & ' & " dans le NomClient
NomClient = Replace(NomClient, ",", "")
NomClient = Replace(NomClient, "'", "")
NomClient = Replace(NomClient, """", "")
'Lit tous les noms clients dans la table MapLocations de la BD
Try
While myReader.Read()
ClientArray.Add(myReader.GetString(0))
End While
Finally
myReader.Close()
End Try
'Si NomClient existe déjà dans la BD alors sortir du Sub
Dim i
For i = 0 To ClientArray.Count - 1
If ClientArray.Item(i) = NomClient Then
Exit Sub
End If
Next i
'Sinon
If AdresseClient Is Nothing Then
Dim myCommand As New SqlCommand("cmdMapLocations_Add", Connexion)
myCommand.CommandType = CommandType.StoredProcedure
Dim LocationID As New SqlParameter("@LocationID", SqlDbType.Int)
LocationID.Direction = ParameterDirection.InputOutput
LocationID.Value = 1
Dim LocationName As New SqlParameter("@LocationName", SqlDbType.NVarChar)
LocationName.Value = NomClient
Dim Details As New SqlParameter("@Details", SqlDbType.NVarChar)
Details.Value = ""
Dim LocationType As New SqlParameter("@LocationType", SqlDbType.TinyInt)
LocationType.Value = 1
Dim ShapeType As New SqlParameter("@ShapeType", SqlDbType.TinyInt)
ShapeType.Value = 0
Dim LocationSource As New SqlParameter("@LocationSource", SqlDbType.TinyInt)
LocationSource.Value = 1
Dim PointLongitude As New SqlParameter("@PointLongitude", SqlDbType.Real)
PointLongitude.Value = longitude
Dim PointLatitude As New SqlParameter("@PointLatitude", SqlDbType.Real)
PointLatitude.Value = latitude
Dim PointRadius As New SqlParameter("@PointRadius", SqlDbType.Int)
PointRadius.Value = 50
Dim UpperLeftLongitude As New SqlParameter("@UpperLeftLongitude", SqlDbType.Real)
UpperLeftLongitude.Value = longitude - 0.000644
Dim UpperLeftLatitude As New SqlParameter("@UpperLeftLatitude", SqlDbType.Real)
UpperLeftLatitude.Value = latitude + 0.00045
Dim LowerRightLongitude As New SqlParameter("@LowerRightLongitude", SqlDbType.Real)
LowerRightLongitude.Value = longitude + 0.000644
Dim LowerRightLatitude As New SqlParameter("@LowerRightLatitude", SqlDbType.Real)
LowerRightLatitude.Value = latitude - 0.00045
myCommand.Parameters.Add(LocationID)
myCommand.Parameters.Add(LocationName)
myCommand.Parameters.Add(Details)
myCommand.Parameters.Add(LocationType)
myCommand.Parameters.Add(ShapeType)
myCommand.Parameters.Add(LocationSource)
myCommand.Parameters.Add(PointLongitude)
myCommand.Parameters.Add(PointLatitude)
myCommand.Parameters.Add(PointRadius)
myCommand.Parameters.Add(UpperLeftLongitude)
myCommand.Parameters.Add(UpperLeftLatitude)
myCommand.Parameters.Add(LowerRightLongitude)
myCommand.Parameters.Add(LowerRightLatitude)
myCommand.ExecuteNonQuery()
Else
Dim myCommand As New SqlCommand("cmdMapLocations_Add", Connexion)
myCommand.CommandType = CommandType.StoredProcedure
Dim LocationID As New SqlParameter("@LocationID", SqlDbType.Int)
LocationID.Direction = ParameterDirection.InputOutput
LocationID.Value = 1
Dim LocationName As New SqlParameter("@LocationName", SqlDbType.NVarChar)
LocationName.Value = NomClient
Dim Details As New SqlParameter("@Details", SqlDbType.NVarChar)
Details.Value = "Street=" & CStr(AdresseClient.Street) & _
" ;City=" & CStr(AdresseClient.City) & " ;Zip=" & CStr(AdresseClient.PostalCode) & _
" ;Country=France;"
Dim LocationType As New SqlParameter("@LocationType", SqlDbType.TinyInt)
LocationType.Value = 1
Dim ShapeType As New SqlParameter("@ShapeType", SqlDbType.TinyInt)
ShapeType.Value = 0
Dim LocationSource As New SqlParameter("@LocationSource", SqlDbType.TinyInt)
LocationSource.Value = 1
Dim PointLongitude As New SqlParameter("@PointLongitude", SqlDbType.Real)
PointLongitude.Value = longitude
Dim PointLatitude As New SqlParameter("@PointLatitude", SqlDbType.Real)
PointLatitude.Value = latitude
Dim PointRadius As New SqlParameter("@PointRadius", SqlDbType.Int)
PointRadius.Value = 50
Dim UpperLeftLongitude As New SqlParameter("@UpperLeftLongitude", SqlDbType.Real)
UpperLeftLongitude.Value = longitude - 0.00064
Dim UpperLeftLatitude As New SqlParameter("@UpperLeftLatitude", SqlDbType.Real)
UpperLeftLatitude.Value = latitude + 0.00045
Dim LowerRightLongitude As New SqlParameter("@LowerRightLongitude", SqlDbType.Real)
LowerRightLongitude.Value = longitude + 0.00064
Dim LowerRightLatitude As New SqlParameter("@LowerRightLatitude", SqlDbType.Real)
LowerRightLatitude.Value = latitude - 0.00045
myCommand.Parameters.Add(LocationID)
myCommand.Parameters.Add(LocationName)
myCommand.Parameters.Add(Details)
myCommand.Parameters.Add(LocationType)
myCommand.Parameters.Add(ShapeType)
myCommand.Parameters.Add(LocationSource)
myCommand.Parameters.Add(PointLongitude)
myCommand.Parameters.Add(PointLatitude)
myCommand.Parameters.Add(PointRadius)
myCommand.Parameters.Add(UpperLeftLongitude)
myCommand.Parameters.Add(UpperLeftLatitude)
myCommand.Parameters.Add(LowerRightLongitude)
myCommand.Parameters.Add(LowerRightLatitude)
myCommand.ExecuteNonQuery()
End If
End Sub
Private Sub ButtonAide_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles ButtonAide.Click
'Fenêtre d'aide
Dim AideClass As Aide = New Aide
AideClass.Show()
End Sub
End Class
Vous n'êtes pas encore membre ?
inscrivez-vous, c'est gratuit et ça prend moins d'une minute !
Les membres obtiennent plus de réponses que les utilisateurs anonymes.
Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.
Le fait d'être membre vous permet d'avoir des options supplémentaires.