Option Explicit
Private Sub CreateMetersPerDegree()
Dim cSQL As String
cSQL = ""
cSQL = cSQL & vbCrLf & "If Not Exists( Select * "
cSQL = cSQL & vbCrLf & " From Information_Schema.Routines "
cSQL = cSQL & vbCrLf & " Where Specific_Name = 'MetresPerDegreeLong' "
cSQL = cSQL & vbCrLf & " And Routine_Type = 'Function' "
cSQL = cSQL & vbCrLf & " ) "
cSQL = cSQL & vbCrLf & "Create Function MetresPerDegreeLong(@Latitude Float) "
cSQL = cSQL & vbCrLf & "Returns Float "
cSQL = cSQL & vbCrLf & "As "
cSQL = cSQL & vbCrLf & "Begin "
cSQL = cSQL & vbCrLf & "Declare @gEARTH_CIRCUM_METRES Float "
cSQL = cSQL & vbCrLf & " "
cSQL = cSQL & vbCrLf & "Set @gEARTH_CIRCUM_METRES = 6378007 * 2 * 3.14159265 "
cSQL = cSQL & vbCrLf & ""
cSQL = cSQL & vbCrLf & "Return (Cos(@Latitude * (3.14159265 / 180)) * @gEARTH_CIRCUM_METRES) / 360 "
cSQL = cSQL & vbCrLf & " "
cSQL = cSQL & vbCrLf & "End"
Call db.Execute(cSQL)
End Sub
Private Sub CreateCalculateDistance()
Dim cSQL As String
cSQL = ""
cSQL = cSQL & vbCrLf & "If Not Exists( Select * "
cSQL = cSQL & vbCrLf & " From Information_Schema.Routines "
cSQL = cSQL & vbCrLf & " Where Specific_Name = 'CalculateDistance' "
cSQL = cSQL & vbCrLf & " And Routine_Type = 'Function' "
cSQL = cSQL & vbCrLf & " ) "
cSQL = cSQL & vbCrLf & "Create Function CalculateDistance(@Longitude1 Float, @Latitude1 Float, @Longitude2 Float, @Latitude2 Float) "
cSQL = cSQL & vbCrLf & "Returns Float "
cSQL = cSQL & vbCrLf & "AS "
cSQL = cSQL & vbCrLf & "Begin "
cSQL = cSQL & vbCrLf & " "
cSQL = cSQL & vbCrLf & " Declare @DeltaX Float "
cSQL = cSQL & vbCrLf & " Declare @DeltaY Float "
cSQL = cSQL & vbCrLf & " Declare @DeltaXMeters Float "
cSQL = cSQL & vbCrLf & " Declare @DeltaYMeters Float "
cSQL = cSQL & vbCrLf & " Declare @MetersPerDegreeLong Float "
cSQL = cSQL & vbCrLf & " Declare @CenterY Float "
cSQL = cSQL & vbCrLf & " "
cSQL = cSQL & vbCrLf & " Set @DeltaX = Abs(@Longitude2 - @Longitude1) "
cSQL = cSQL & vbCrLf & " Set @DeltaY = Abs(@Latitude2 - @Latitude1) "
cSQL = cSQL & vbCrLf & " Set @CenterY = (@Latitude1 + @Latitude2) / 2 "
cSQL = cSQL & vbCrLf & " Set @MetersPerDegreeLong = dbo.MetresPerDegreeLong(@CenterY) "
cSQL = cSQL & vbCrLf & " Set @DeltaXMeters = @DeltaX * @MetersPerDegreeLong "
cSQL = cSQL & vbCrLf & " Set @DeltaYMeters = @DeltaY * 111113.519 "
cSQL = cSQL & vbCrLf & " Return Sqrt(@DeltaXMeters * @DeltaXMeters + @DeltaYMeters * @DeltaYMeters) / 1609.344 "
cSQL = cSQL & vbCrLf & " "
cSQL = cSQL & vbCrLf & "End "
Call db.Execute(cSQL)
End Sub
Public Sub CreateGetZipCodesWithin50Miles()
Dim cSQL As String
cSQL = cSQL & vbCrLf & "If Not Exists( Select * "
cSQL = cSQL & vbCrLf & " From Information_Schema.Routines "
cSQL = cSQL & vbCrLf & " Where Specific_Name = 'GetZipCodesWithin50Miles' "
cSQL = cSQL & vbCrLf & " And Routine_Type = 'Procedure' "
cSQL = cSQL & vbCrLf & " ) "
cSQL = cSQL & vbCrLf & "Create Procedure GetZipCodesWithin50Miles "
cSQL = cSQL & vbCrLf & " @ZipCode Integer "
cSQL = cSQL & vbCrLf & "As "
cSQL = cSQL & vbCrLf & "SET NOCOUNT ON "
cSQL = cSQL & vbCrLf & " "
cSQL = cSQL & vbCrLf & "Declare @Longitude Decimal(9,6) "
cSQL = cSQL & vbCrLf & "Declare @Latitude Decimal(9,6) "
cSQL = cSQL & vbCrLf & " "
cSQL = cSQL & vbCrLf & "Select @Longitude = Longitude, "
cSQL = cSQL & vbCrLf & " @Latitude = Latitude "
cSQL = cSQL & vbCrLf & "From Zip_Codes "
cSQL = cSQL & vbCrLf & "Where ZipCode = @ZipCode "
cSQL = cSQL & vbCrLf & " "
cSQL = cSQL & vbCrLf & "Declare @Temp Table(ZipCode Integer, Longitude Decimal(9,6), Latitude Decimal(9,6)) "
cSQL = cSQL & vbCrLf & " "
cSQL = cSQL & vbCrLf & "Select A.ZipCode, "
cSQL = cSQL & vbCrLf & " Zip_Codes.City, "
cSQL = cSQL & vbCrLf & " Zip_Codes.State "
cSQL = cSQL & vbCrLf & "From ( "
cSQL = cSQL & vbCrLf & " Select ZiPCode, Longitude, Latitude "
cSQL = cSQL & vbCrLf & " From Zip_Codes "
cSQL = cSQL & vbCrLf & " Where Longitude Between (@Longitude - 1) And (@Longitude + 1) "
cSQL = cSQL & vbCrLf & " And Latitude Between (@Latitude - 1) And (@Latitude + 1) "
cSQL = cSQL & vbCrLf & " ) A "
cSQL = cSQL & vbCrLf & " Inner Join Zip_Codes On A.ZipCode = Zip_Codes.ZipCode "
cSQL = cSQL & vbCrLf & "Where dbo.CalculateDistance(@Longitude, @Latitude, A.Longitude, A.Latitude) <= 50 "
Call db.Execute(cSQL)
End Sub