GeoIP Pb APi

;EnableExplicit

;By Celtic88 2016(c) v: 1.1 new update 2017 add support for ipv6
Macro GEOIP_CHKBIT_V6(bit,ptr)
  (ptr\u_char[((127 - bit) >> 3)] & (1 << (~(127 - bit) & 7)))
EndMacro

Structure in6_addr
  StructureUnion
    u_char.b[16];
    u_short.w[8];
  EndStructureUnion
EndStructure

#GeoIPMaxContry = 255

Global Dim GeoIP_CountryNames.s(#GeoIPMaxContry)
Global Dim GeoIP_CountryCodes.s(#GeoIPMaxContry)
Global Dim GeoIP_CountryContinent.s(#GeoIPMaxContry)
Global Dim GeoIP_CountryCodes3.s(#GeoIPMaxContry)
Global Dim GeoIP_Countrytimezone.s(2,715)

IncludeFile "GeoIPData.PBI"

Procedure.b GeoIP_ini()
  Protected Ii.a,uo.l
  Restore GeoIP_DCountryNames
  For Ii = 0 To #GeoIPMaxContry
    Read.s GeoIP_CountryNames(Ii)
  Next
  Restore GeoIP_DCountryCodes
  For Ii = 0 To #GeoIPMaxContry
    Read.s GeoIP_CountryCodes(Ii)
  Next
  Restore GeoIP_DCountryContinent
  For Ii = 0 To #GeoIPMaxContry
    Read.s GeoIP_CountryContinent(Ii)
  Next
  Restore GeoIP_DCountryCodes3
  For Ii = 0 To #GeoIPMaxContry
    Read.s GeoIP_CountryCodes3(Ii)
  Next
  Restore GeoIP_Dtimezone
  For uo = 0 To 715
    For Ii = 0 To 2
      Read.s GeoIP_Countrytimezone(Ii,uo)
    Next
  Next
EndProcedure

GeoIP_ini()

#STRUCTURE_INFO_MAX_SIZE = 20
#FULL_RECORD_LENGTH = 50
#COUNTRY_BEGIN = 16776960

#GEOIP_COUNTRY_EDITION = 1
#GEOIP_COUNTRY_EDITION_V6 = 12
#GEOIP_CITY_EDITION_REV1 = 2
#GEOIP_CITY_EDITION_REV1_V6 = 30
#GEOIP_ASNUM_EDITION = 9
#GEOIP_ASNUM_EDITION_V6 = 21

Structure GeoIP_Info
  GeoIP_databaseType.a
  GeoIP_Path.s
  GeoIP_fCach_Memory.b
  *GeoIP_datBuffer
  GeoIP_File_ID.i
  GeoIP_Size.l
  GeoIP_databaseSegments.l
EndStructure

Structure GeoIPRecord
  Index_Data.l
  country_code.s
  country_code3.s
  country_name.s
  region.s
  city.s
  postal_code.s
  latitude.f
  longitude.f
  metro_code.l
  area_code.l
  continent_code.s
  Geo_Asn.s
  time_zone.s
  GeoIP_databaseType.a
EndStructure

Procedure.b GeoIP_Free(*iGeoIP_Info.GeoIP_Info)
  If *iGeoIP_Info < 1
    ProcedureReturn 0
  EndIf
  With *iGeoIP_Info
    If \GeoIP_File_ID
      CloseFile(\GeoIP_File_ID)
    EndIf
  EndWith
  ClearStructure(*iGeoIP_Info, GeoIP_Info)
  FreeMemory(*iGeoIP_Info)
EndProcedure

Procedure.i GeoIP_OPen(GeoIP_Path.s,GeoIP_fCach_Memory.b=0,*GeoIP_datBuffer=0,GeoIP_datBufferSize.l=0)

  Protected GetSize.l = GeoIP_datBufferSize
  Protected Dim buf.a(2)
  Protected Ii.l,j.l,nRdb.l
  Protected GoPenf.i

  If GeoIP_fCach_Memory
    If Not *GeoIP_datBuffer Or Not GeoIP_datBufferSize
      ProcedureReturn -1
    EndIf
  Else
    GetSize = FileSize(GeoIP_Path)
    If GetSize > 0
      GoPenf = OpenFile(#PB_Any,GeoIP_Path)
    Else
      ProcedureReturn -1
    EndIf
    If GoPenf =0
      ProcedureReturn -1
    EndIf
  EndIf

  Protected *iGeoIP_Info.GeoIP_Info = AllocateMemory(SizeOf(GeoIP_Info))
  If *iGeoIP_Info =0
    CloseFile(GoPenf)
    ProcedureReturn -2
  EndIf

  With *iGeoIP_Info
    \GeoIP_databaseType = #GEOIP_COUNTRY_EDITION
    \GeoIP_databaseSegments = #COUNTRY_BEGIN
    \GeoIP_datBuffer = *GeoIP_datBuffer
    \GeoIP_fCach_Memory = GeoIP_fCach_Memory
    \GeoIP_File_ID = GoPenf
    \GeoIP_Size = GeoIP_datBufferSize

    GetSize-3

    If Not \GeoIP_fCach_Memory
      FileSeek(\GeoIP_File_ID, GetSize)
    EndIf

    For Ii=0 To #STRUCTURE_INFO_MAX_SIZE - 1

      If \GeoIP_fCach_Memory
        nRdb = CopyMemory(\GeoIP_datBuffer + GetSize, @BUF(), 3)
      Else
        nRdb = ReadData(\GeoIP_File_ID,@BUF(), 3)
      EndIf

      If nRdb < 3
        GeoIP_Free(*iGeoIP_Info)
        ProcedureReturn -3
      EndIf

      If BUF(0) = 255 And BUF(1) = 255 And BUF(2) = 255

        GetSize + 3

        If \GeoIP_fCach_Memory

          \GeoIP_databaseType = PeekA(\GeoIP_datBuffer + GetSize)
          nRdb = CopyMemory(\GeoIP_datBuffer + GetSize + 1, @BUF(), 3)

        Else

          FileSeek(\GeoIP_File_ID, GetSize)
          \GeoIP_databaseType = ReadAsciiCharacter(\GeoIP_File_ID)
          FileSeek(\GeoIP_File_ID, GetSize + 1)
          nRdb = ReadData(\GeoIP_File_ID,@BUF(), 3)

        EndIf

        If nRdb < 3
          GeoIP_Free(*iGeoIP_Info)
          ProcedureReturn -3
        EndIf

        If \GeoIP_databaseType = #GEOIP_COUNTRY_EDITION_V6
          Break
        EndIf

        If \GeoIP_databaseType = #GEOIP_ASNUM_EDITION_V6 Or
           \GeoIP_databaseType = #GEOIP_CITY_EDITION_REV1 Or
           \GeoIP_databaseType = #GEOIP_ASNUM_EDITION Or
           \GeoIP_databaseType = #GEOIP_CITY_EDITION_REV1_V6

          \GeoIP_databaseSegments = 0
          For j = 0 To 2
            \GeoIP_databaseSegments + (BUF(j) << (j * 8))
          Next

        Else

          GeoIP_Free(*iGeoIP_Info)
          ProcedureReturn -4

        EndIf

      EndIf

      GetSize - 4

      If Not \GeoIP_fCach_Memory
        FileSeek(\GeoIP_File_ID, GetSize)
      EndIf

    Next

    If Not \GeoIP_fCach_Memory
      FileSeek(\GeoIP_File_ID, 0)
    EndIf

  EndWith
  ProcedureReturn *iGeoIP_Info
EndProcedure

Procedure.l GeoIP_Seek_Record_IPV6(*iGeoIP_Info.GeoIP_Info,*IPAddressnum.in6_addr)

  If *iGeoIP_Info < 1
    ProcedureReturn -1
  EndIf

  Protected depth.l
  Protected x.l ,nRdb.l
  Protected Dim stack_buffer.a(2 * 3)
  Protected offset.l = 0
  Protected record_pair_length.l = 6
  Protected byte_offset.l

  With *iGeoIP_Info

    For depth = 127 To 0 Step -1

      byte_offset = record_pair_length * offset

      If \GeoIP_fCach_Memory
        nRdb = CopyMemory(\GeoIP_datBuffer + byte_offset, @stack_buffer(), record_pair_length)
      Else
        FileSeek(\GeoIP_File_ID,byte_offset)
        nRdb = ReadData(\GeoIP_File_ID,@stack_buffer(), record_pair_length)
      EndIf

      If nRdb < record_pair_length
        ProcedureReturn -2
      EndIf

      If GEOIP_CHKBIT_V6(depth,*IPAddressnum)

        x = (stack_buffer(3 * 1 + 0) << (0 * 8)) +
            (stack_buffer(3 * 1 + 1) << (1 * 8)) +
            (stack_buffer(3 * 1 + 2) << (2 * 8))

      Else

        x = (stack_buffer(3 * 0 + 0) << (0 * 8)) +
            (stack_buffer(3 * 0 + 1) << (1 * 8)) +
            (stack_buffer(3 * 0 + 2) << (2 * 8))

      EndIf

      If (x >= \GeoIP_databaseSegments)
        ProcedureReturn x
      EndIf

      offset = x
    Next

  EndWith
EndProcedure

Procedure.l GeoIP_Seek_Record(*iGeoIP_Info.GeoIP_Info,ipnum.q)
  If *iGeoIP_Info < 1
    ProcedureReturn -1
  EndIf

  Protected depth.l
  Protected x.l ,nRdb.l
  Protected Dim stack_buffer.a(2 * 3)
  Protected offset.l = 0
  Protected record_pair_length.l = 6
  Protected byte_offset.l

  With *iGeoIP_Info

    For depth = 31 To 0 Step -1

      byte_offset = record_pair_length * offset

      If \GeoIP_fCach_Memory
        nRdb = CopyMemory(\GeoIP_datBuffer + byte_offset, @stack_buffer(), record_pair_length)
      Else
        FileSeek(\GeoIP_File_ID,byte_offset)
        nRdb = ReadData(\GeoIP_File_ID,@stack_buffer(), record_pair_length)
      EndIf

      If nRdb < record_pair_length
        ProcedureReturn -2
      EndIf

      If (ipnum & (1 << depth))

        x = (stack_buffer(3 * 1 + 0) << (0 * 8)) +
            (stack_buffer(3 * 1 + 1) << (1 * 8)) +
            (stack_buffer(3 * 1 + 2) << (2 * 8))

      Else

        x = (stack_buffer(3 * 0 + 0) << (0 * 8)) +
            (stack_buffer(3 * 0 + 1) << (1 * 8)) +
            (stack_buffer(3 * 0 + 2) << (2 * 8))

      EndIf

      If (x >= \GeoIP_databaseSegments)
        ProcedureReturn x
      EndIf

      offset = x
    Next

  EndWith
  ProcedureReturn 0
EndProcedure

Procedure.s GeoIP_Get_ASMname(*iGeoIP_Info.GeoIP_Info,seek_record.l)

  If *iGeoIP_Info < 1
    ProcedureReturn ""
  EndIf

  If seek_record < 1
    ProcedureReturn ""
  EndIf

  Protected Dim record_buf.a(#FULL_RECORD_LENGTH-1)
  Protected record_pointer.l, nRdb.l

  With *iGeoIP_Info
    record_pointer = seek_record + (5) * \GeoIP_databaseSegments

    If \GeoIP_fCach_Memory
      nRdb = CopyMemory(\GeoIP_datBuffer + record_pointer, @record_buf(), #FULL_RECORD_LENGTH)
    Else
      FileSeek(\GeoIP_File_ID, record_pointer)
      nRdb = ReadData(\GeoIP_File_ID, @record_buf(), #FULL_RECORD_LENGTH)
    EndIf

    If nRdb < #FULL_RECORD_LENGTH
      ProcedureReturn ""
    EndIf

  EndWith

  ProcedureReturn PeekS(@record_buf(),-1,#PB_UTF8)
EndProcedure

Procedure.s GeoIP_Time_Zone_By_Country_and_Region(country.s, region.s)
  Protected uo.l
  For uo = 0 To 715
    If GeoIP_Countrytimezone(0,uo) = country
      If GeoIP_Countrytimezone(1,uo) <> "*" And region <> ""
        For uo = uo To 715
          If GeoIP_Countrytimezone(1,uo) = region
            Break
          EndIf
        Next
        Break
      Else
        Break
      EndIf
    EndIf
  Next
  If uo < 716
    ProcedureReturn GeoIP_Countrytimezone(2,uo)
  EndIf
  ProcedureReturn ""
EndProcedure

Procedure.b GeoIP_Extract_Record(*iGeoIP_Info.GeoIP_Info, *iGeoIPRecord.GeoIPRecord, seek_record.l)
  If *iGeoIP_Info < 1
    ProcedureReturn -1
  EndIf
  ClearStructure(*iGeoIPRecord, GeoIPRecord)
  If Not *iGeoIPRecord
    ProcedureReturn -1
  EndIf

  If seek_record < 0
    ProcedureReturn 0
  EndIf

  *iGeoIPRecord\GeoIP_databaseType = *iGeoIP_Info\GeoIP_databaseType

  If *iGeoIP_Info\GeoIP_databaseType = #GEOIP_COUNTRY_EDITION Or *iGeoIP_Info\GeoIP_databaseType = #GEOIP_COUNTRY_EDITION_V6
    seek_record - *iGeoIP_Info\GeoIP_databaseSegments
    If seek_record > -1 And seek_record < #GeoIPMaxContry +1
      With *iGeoIPRecord
        \Index_Data = seek_record
        \country_name =GeoIP_CountryNames(\Index_Data )
        \country_code = GeoIP_CountryCodes(\Index_Data )
        \continent_code = GeoIP_CountryContinent(\Index_Data )
        \country_code3 = GeoIP_CountryCodes3(\Index_Data )
        \time_zone = GeoIP_time_zone_by_country_and_region(\country_code ,"")
        ProcedureReturn 1
      EndWith
    EndIf
    ProcedureReturn 0
  EndIf

  Protected record_pointer.l
  Protected Dim record_buf.a(#FULL_RECORD_LENGTH-1)
  Protected str_length.l = 0, nRdb.l, j.l

  Protected latitude.f = 0
  Protected longitude.f = 0
  Protected latitudei.i = 0
  Protected longitudei.i = 0
  Protected metroarea_combo.l = 0

  With *iGeoIP_Info

    record_pointer = seek_record + 5 * \GeoIP_databaseSegments

    If \GeoIP_fCach_Memory
      nRdb = CopyMemory(\GeoIP_datBuffer + record_pointer, @record_buf(), #FULL_RECORD_LENGTH)
    Else
      FileSeek(\GeoIP_File_ID, record_pointer)
      nRdb = ReadData(\GeoIP_File_ID, @record_buf(), #FULL_RECORD_LENGTH)
    EndIf

    If nRdb < #FULL_RECORD_LENGTH
      ProcedureReturn -2
    EndIf

  EndWith

  ;   ShowMemoryViewer(@record_buf(),50)

  If record_buf(0) > -1 And record_buf(0) < #GeoIPMaxContry +1
    With *iGeoIPRecord
      \Index_Data = record_buf(0)
      \country_name =GeoIP_CountryNames(\Index_Data )
      \country_code = GeoIP_CountryCodes(\Index_Data )
      \continent_code = GeoIP_CountryContinent(\Index_Data )
      \country_code3 = GeoIP_CountryCodes3(\Index_Data )
      \region = PeekS(@record_buf(1),-1, #PB_UTF8)
      \time_zone = GeoIP_time_zone_by_country_and_region(\country_code ,\region)

      str_length + Len(\region) + 1 + 1

      \city = PeekS(@record_buf(str_length),-1,#PB_UTF8)

      str_length + Len(\city) + 1

      \postal_code = PeekS(@record_buf(str_length),-1,#PB_UTF8)

      str_length + Len(\postal_code) + 1

      For j = 0 To 2
        latitudei + (record_buf(str_length + j) << (j * 8))
      Next
      \latitude = (latitudei / 10000 - 180)

      str_length + 3

      For j = 0 To 2
        longitudei + (record_buf(str_length+j) << (j * 8))
      Next
      \longitude = (longitudei / 10000 - 180)

      str_length + 3

      If \country_code = "US"
        For j = 0 To 2
          metroarea_combo + (record_buf(str_length+j) << (j * 8))
        Next
        \metro_code = metroarea_combo / 1000
        \area_code = metroarea_combo % 1000
      EndIf

    EndWith
    ProcedureReturn 1
  EndIf
  ProcedureReturn 0
EndProcedure