⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 glbf.bas

📁 gps 源码 vb+access 其他地方很难找到 很详细的说明
💻 BAS
📖 第 1 页 / 共 2 页
字号:
Attribute VB_Name = "GlbFunction"
Option Explicit

Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
Declare Function WritePrivateProfileString Lib "kernel32" Alias "WritePrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpString As Any, ByVal lpFileName As String) As Long
Sub Main()
Form4.Show
End Sub


Public Function errorhandler() As Integer
    Dim msg, title As String
    Dim style, response As Long
    msg = "系统异常错误!" + Chr(13) + Chr(10) + "Abort-退出系统 Retry-再试 Igone-跳过"
    style = vbAbortRetryIgnore
    title = "错误"
    
    errorhandler = MsgBox(msg, style, title)
End Function


'----------------------读写系统注册信息------------------------------
Public Function Ini_GetPath() As String
    Dim lll As Long
    Dim Temp_Ini As String * 20
    Dim i As Integer
    lll = GetPrivateProfileString("Gps", "MDBPath", "c:\gps\", Temp_Ini, 20, "c:\gps\system\gps.ini")
    For i = 1 To Len(Temp_Ini)
        If Asc(Mid(Temp_Ini, i, 1)) <> 0 Then
           Ini_GetPath = Ini_GetPath + Mid(Temp_Ini, i, 1)
        End If
    Next
End Function
Public Sub Ini_SavePath(ByVal strPath As String)
    Dim lll As Long
    lll = WritePrivateProfileString("Gps", "MDBPath", strPath, "c:\gps\system\Gps.ini")
End Sub

Public Function Ini_GetDefaultSpaDBFileName() As String
    Dim lll As Long
    Dim Temp_Ini As String * 20
    Dim i As Integer
    lll = GetPrivateProfileString("MapInfo", "MapName_xdb", "d:\zz.xdb", Temp_Ini, 20, "c:\gps\system\gps.ini")
    For i = 1 To Len(Temp_Ini)
        If Asc(Mid(Temp_Ini, i, 1)) <> 0 Then
           Ini_GetDefaultSpaDBFileName = Ini_GetDefaultSpaDBFileName + Mid(Temp_Ini, i, 1)
        End If
    Next
End Function
Public Sub Ini_SaveDefaultSpaDBFileName(ByVal strFileName As String)
    Dim lll As Long
    lll = WritePrivateProfileString("MapInfo", "MapName_xdb", strFileName, "c:\gps\system\Gps.ini")
End Sub

Public Function Ini_GetDefaultCMPName() As String
    Dim lll As Long
    Dim Temp_Ini As String * 20
    Dim i As Integer
    lll = GetPrivateProfileString("MapInfo", "MapName_fh", "default4", Temp_Ini, 20, "c:\gps\system\gps.ini")
    For i = 1 To Len(Temp_Ini)
        If Asc(Mid(Temp_Ini, i, 1)) <> 0 Then
           Ini_GetDefaultCMPName = Ini_GetDefaultCMPName + Mid(Temp_Ini, i, 1)
        End If
    Next
End Function
Public Sub Ini_SaveDefaultCMPName(ByVal strCMPName As String)
    Dim lll As Long
    lll = WritePrivateProfileString("MapInfo", "MapName_fh", strCMPName, "c:\gps\system\Gps.ini")
End Sub

Public Function Ini_GetAlertLayerName() As String
    Ini_GetAlertLayerName = GetSetting("Gps", "Option", "AlertLayerName", "")
End Function
Public Sub Ini_SaveAlertLayerName(ByVal strName As String)
    SaveSetting "Gps", "Option", "AlertLayerName", strName
End Sub

Public Sub Ini_GetCommSetting(ByVal Name1 As String, Port As Integer, ByRef Baud As String, ByRef parity As String, ByRef DataBit As String, ByRef StopBit As String)
    Dim lll As Long
    Dim temp_sz As String * 10
    Dim i As Integer
    lll = GetPrivateProfileString(Name1, "Port", "1", temp_sz, "10", "c:\gps\system\Gps.ini")
    Port = CInt(temp_sz)
    lll = GetPrivateProfileString(Name1, "Baud", "4800", temp_sz, "10", "c:\gps\system\Gps.ini")
    Baud = ""
    For i = 1 To Len(temp_sz)
        If Asc(Mid(temp_sz, i, 1)) <> 0 Then
           Baud = Baud + Mid(temp_sz, i, 1)
        End If
    Next
    temp_sz = ""
    StopBit = ""
    lll = GetPrivateProfileString(Name1, "StopBit", "1", temp_sz, "10", "c:\gps\system\Gps,ini")
    For i = 1 To Len(Trim(temp_sz))
        If Asc(Mid(Trim(temp_sz), i, 1)) <> 0 Then
           StopBit = StopBit + Mid(temp_sz, i, 1)
        End If
    Next
    temp_sz = ""
    DataBit = ""
    lll = GetPrivateProfileString(Name1, "DataBit", "8", temp_sz, "10", "c:\gps\system\Gps,ini")
    For i = 1 To Len(Trim(temp_sz))
        If Asc(Mid(Trim(temp_sz), i, 1)) <> 0 Then
           DataBit = DataBit + Mid(temp_sz, i, 1)
        End If
    Next
    temp_sz = ""
    parity = ""
    lll = GetPrivateProfileString(Name1, "Parity", "N", temp_sz, "10", "c:\gps\system\Gps.ini")
    For i = 1 To Len(Trim(temp_sz))
        If Asc(Mid(Trim(temp_sz), i, 1)) <> 0 Then
           parity = parity + Mid(temp_sz, i, 1)
        End If
    Next
End Sub
Public Sub Ini_SaveCommSetting(ByVal Name1 As String, ByVal Port As Integer, ByVal Baud As String, ByVal parity As String, ByVal DataBit As String, ByVal StopBit As String)
    Dim lll As Long
    lll = WritePrivateProfileString(Name1, "Port", CStr(Port), "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Name1", "Baud", Baud, "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Name1", "StopBit", StopBit, "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Name1", "DataBit", DataBit, "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Name1", "Parity", parity, "c:\gps\system\Gps.ini")
End Sub


Public Sub Ini_GetComm2Setting(ByRef Port As Integer, ByRef Baud As String, ByRef parity As String, ByRef DataBit As String, ByRef StopBit As String)
    Dim lll As Long
    Dim temp_sz As String * 10
    Dim i As Integer
    lll = GetPrivateProfileString("Comm2", "Port", "1", temp_sz, "10", "c:\gps\system\Gps.ini")
    Port = CInt(temp_sz)
    lll = GetPrivateProfileString("Comm2", "Baud", "4800", temp_sz, "10", "c:\gps\system\Gps.ini")
    Baud = ""
    For i = 1 To Len(temp_sz)
        If Asc(Mid(temp_sz, i, 1)) <> 0 Then
           Baud = Baud + Mid(temp_sz, i, 1)
        End If
    Next
    temp_sz = ""
    StopBit = ""
    lll = GetPrivateProfileString("Comm2", "StopBit", "1", temp_sz, "10", "c:\gps\system\Gps,ini")
    For i = 1 To Len(Trim(temp_sz))
        If Asc(Mid(Trim(temp_sz), i, 1)) <> 0 Then
           StopBit = StopBit + Mid(temp_sz, i, 1)
        End If
    Next
    temp_sz = ""
    DataBit = ""
    lll = GetPrivateProfileString("Comm2", "DataBit", "8", temp_sz, "10", "c:\gps\system\Gps,ini")
    For i = 1 To Len(Trim(temp_sz))
        If Asc(Mid(Trim(temp_sz), i, 1)) <> 0 Then
           DataBit = DataBit + Mid(temp_sz, i, 1)
        End If
    Next
    temp_sz = ""
    parity = ""
    lll = GetPrivateProfileString("Comm2", "Parity", "N", temp_sz, "10", "c:\gps\system\Gps.ini")
    For i = 1 To Len(Trim(temp_sz))
        If Asc(Mid(Trim(temp_sz), i, 1)) <> 0 Then
           parity = parity + Mid(temp_sz, i, 1)
        End If
    Next
End Sub

Public Sub Ini_SaveComm2Setting(ByVal Port As Integer, ByVal Baud As String, ByVal parity As String, ByVal DataBit As String, ByVal StopBit As String)
    Dim lll As Long
    lll = WritePrivateProfileString("Comm2", "Port", CStr(Port), "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Comm2", "Baud", Baud, "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Comm2", "StopBit", StopBit, "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Comm2", "DataBit", DataBit, "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Comm2", "Parity", parity, "c:\gps\system\Gps.ini")
End Sub
Public Sub Ini_GetComm3Setting(ByRef Port As Integer, ByRef Baud As String, ByRef parity As String, ByRef DataBit As String, ByRef StopBit As String)
    Dim lll As Long
    Dim temp_sz As String * 10
    Dim i As Integer
    lll = GetPrivateProfileString("Comm3", "Port", "1", temp_sz, "10", "c:\gps\system\Gps.ini")
    Port = CInt(temp_sz)
    lll = GetPrivateProfileString("Comm3", "Baud", "4800", temp_sz, "10", "c:\gps\system\Gps.ini")
    Baud = ""
    For i = 1 To Len(temp_sz)
        If Asc(Mid(temp_sz, i, 1)) <> 0 Then
           Baud = Baud + Mid(temp_sz, i, 1)
        End If
    Next
    temp_sz = ""
    StopBit = ""
    lll = GetPrivateProfileString("Comm3", "StopBit", "1", temp_sz, "10", "c:\gps\system\Gps,ini")
    For i = 1 To Len(Trim(temp_sz))
        If Asc(Mid(Trim(temp_sz), i, 1)) <> 0 Then
           StopBit = StopBit + Mid(temp_sz, i, 1)
        End If
    Next
    temp_sz = ""
    DataBit = ""
    lll = GetPrivateProfileString("Comm3", "DataBit", "8", temp_sz, "10", "c:\gps\system\Gps,ini")
    For i = 1 To Len(Trim(temp_sz))
        If Asc(Mid(Trim(temp_sz), i, 1)) <> 0 Then
           DataBit = DataBit + Mid(temp_sz, i, 1)
        End If
    Next
    temp_sz = ""
    parity = ""
    lll = GetPrivateProfileString("Comm3", "Parity", "N", temp_sz, "10", "c:\gps\system\Gps.ini")
    For i = 1 To Len(Trim(temp_sz))
        If Asc(Mid(Trim(temp_sz), i, 1)) <> 0 Then
           parity = parity + Mid(temp_sz, i, 1)
        End If
    Next
End Sub


Public Sub Ini_SaveComm3Setting(ByVal Port As Integer, ByVal Baud As String, ByVal parity As String, ByVal DataBit As String, ByVal StopBit As String)
    Dim lll As Long
    lll = WritePrivateProfileString("Comm3", "Port", CStr(Port), "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Comm3", "Baud", Baud, "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Comm3", "StopBit", StopBit, "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Comm3", "DataBit", DataBit, "c:\gps\system\Gps.ini")
    lll = WritePrivateProfileString("Comm3", "Parity", parity, "c:\gps\system\Gps.ini")
End Sub

Public Sub Ini_GetComm4Setting(ByRef Port As Integer, ByRef Baud As String, ByRef parity As String, ByRef DataBit As String, ByRef StopBit As String)
    Dim lll As Long
    Dim temp_sz As String * 10
    Dim i As Integer
    lll = GetPrivateProfileString("Comm4", "Port", "1", temp_sz, "10", "c:\gps\system\Gps.ini")
    Port = CInt(temp_sz)
    lll = GetPrivateProfileString("Comm4", "Baud", "4800", temp_sz, "10", "c:\gps\system\Gps.ini")
    Baud = ""
    For i = 1 To Len(temp_sz)
        If Asc(Mid(temp_sz, i, 1)) <> 0 Then
           Baud = Baud + Mid(temp_sz, i, 1)
        End If
    Next

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -