module1.bas

通过串口与手机模块收发短信。已经用sim100测试过

Attribute VB_Name = "Module1"
Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, lpKeyName As Any, ByVal lpDefault As String, ByVal lpRetunedString 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 lplFileName As String) As Long
Declare Function CallWindowProc Lib "user32" Alias _
         "CallWindowProcA" (ByVal lpPrevWndFunc As Long, ByVal hwnd As _
         Long, ByVal Msg As Long, ByVal wParam As Long, ByVal lParam As _
         Long) As Long
Declare Function SetWindowLong Lib "user32" Alias "SetWindowLongA" _
         (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As _
         Long) As Long
Declare Function ReleaseCapture Lib "user32" () As Long
         
         
Public 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
         
Public Declare Function FindWindow Lib "user32" Alias _
         "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName _
         As String) As Long
         
Public Declare Function SendMessage Lib "user32" Alias _
         "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal _
         wParam As Long, lParam As Any) As Long
         
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
         (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)
         
         
Public Const HWND_TOPMOST& = -1
Public Const SWP_NOSIZE& = &H1
Public Const SWP_NOMOVE& = &H2
Public Const GWL_WNDPROC = (-4)
Public Const WM_COPYDATA = &H4A
Public Const WM_NCLBUTTONDOWN = &HA1
Public Const HTCAPTION = 2




Public Const rPDU = "31"
'Public Const rPDU = "40"
Public Const rMR = "00"  '信息参考值
Public Const rPID = "00"  '协议标志
Public Const rVP = "00"   '有效期为5分钟



Global lpPrevWndProc As Long
Global gHW As Long

Type COPYDATASTRUCT
              dwData As Long
              cbData As Long
              lpData As Long
End Type

Type Pre_Cmd_Set
         Cmd_Name As String
         Cmd_Con As String
         Cmd_Num As Integer
         Cmd_Kind As Integer
         Cmd_Array As Integer
End Type
   
Type Send_Struct
      Sen_Phisical As String
      Sen_Way As String
      Sen_WaitNow As Boolean
      Sen_WaitLater As Boolean
      Sen_Success As Boolean
      Sen_Status As String
      Sen_From As String
      Sen_Form As String
End Type

Type Sen_Data_Struct
      Sen_data As Variant
      Sen_Struct As Send_Struct
End Type
      
Type Serial_Struct
      Ser_Rat As String
      Ser_Comport As String
      Ser_Datalen As String
      Ser_Stoplen As String
      Ser_Judge As String
      Ser_Curcon As String
End Type

Type Ham_Struct
       Ham_Regcode As String
       Ham_Dialcode As String
       Ham_Byterate As String
       Ham_Datapro As String
       Ham_Compress As String
       Ham_Curcon As String
End Type

Type TcpIp_Struct
      TcpIp_Serverip As String
      TcpIp_Comport As String
End Type

Type GsmSendStruct
      SCA As String
      PDU As String
      MR As String
      DA As String
      PID As String
      DCS As String
      VP As String
      UDL As String
      UD As String
      UD_Array() As Byte
End Type

Type GsmRevStruct
      SCA As String
      PDU As String
      OA As String
      PID As String
      DCS As String
      SCTS As String
      UDL As String
      UD As String
      
End Type

Type GsmPreSenStruct
      Sen_Str As GsmSendStruct
      Sen_data As String
      Sen_Wait As Boolean
      Sen_From As String
      Sen_Form As String
      Sen_Success As Boolean
      ReSen_Times As Integer
      Sen_Order As Integer
      Sen_len As Integer
      Sen_Time As String
      Sen_Time_Long As String
      Sen_Array_Data() As Byte
End Type

Type GsmPreRevStruct
      Rev_Str As GsmRevStruct
      'RevRtuPro As GsmProPacket
      'RevMcuPro As McuProPacket
      RevPrimeStr As String
      Rev_ComCode As String
      'Rev_Form As String
      Rev_Order As Integer
      
End Type

Type CmdWaitStruct

      CmdCon As String
      Addr As String
      CmdTime As String
      CmdTimeLong As String
      CmdFrom As String
      CmdForm As String
      
End Type


Public GsmRecArray() As GsmRevStruct
Public GsmPreSenArray() As GsmPreSenStruct

'Type GPRS_Struct
'End Type

Type Test_Pro_Struct
       Test_Rep As Boolean
       Test_Repcon As String
       Test_Jud As Boolean
       Test_Judkind As String
       Test_Len As Boolean
       Test_Lenstart As String
       Test_lenlen As Integer
End Type

Type PrcCon
    Tra_Kind As String
    Pro_Kind As String
    Phi_Kind As String
End Type

Type MessageArray

      Message As String
      MesVal As Boolean
      MesOrd As Integer
      
End Type
 
Public MessaArray() As MessageArray
Public GsmSenArray() As GsmPreSenStruct
Public GsmRevArray() As GsmPreRevStruct

Public ConSerAcc As Boolean
Public ConAndDis As Boolean
Public WaitSenSuc As Boolean
Public WaitFail As Boolean

Public RevArray As Integer
Public SenArray As Integer
Public StartCmdWait As Boolean
Public StartResWait As Boolean
Public ResWaitSuc As Boolean
Public ResWaitInitSuc As Boolean
Public MesArray As Integer
Public MesSenSuc As Boolean
Public ProcessOver As Boolean
Public MesSenOk As Boolean
'Public GSM_MesSenCmd As Boolean
'Public GSM_MesSenStr As Boolean
'Public Gsm_MesInit As Boolean
Public MessageLock As Boolean


Public RevDataEndFlag As Boolean

Public DisJudge As Boolean


  
Public SendAccess As String
Public RevJudgeWay As String

Public GsmInitCmd_ResWaitSuc As Boolean     'GSM 初始化等待
Public GsmInitCmd_ProcessOver As Boolean    'GSM初始化终止

Public GSM_Str_ResWaitSuc As Boolean   '发送信息等待
Public GSM_Str_MesSenSuc As Boolean    '发送信息成功
Public GSM_Str_ProcessOver As Boolean  '发送信息终止标志

Public GSM_Cmd_ResWaitSuc As Boolean   '发送命令等待
Public GSM_Cmd_ProcessOver As Boolean  '发送命令终止标志

Public GSM_Reset_ResWaitSuc As Boolean   '复位命令等待
Public GSM_Reset_ProcessOver As Boolean  '复位命令终止标志

Public GsmDcsSelf As Boolean

'发送数据转换
Public CommonRev_Data As Variant
Public Gsm_CommonRev_Head As Boolean
Public Gsm_CommonRev_Head_Start As Boolean
Public Gsm_CommonRev_End As Boolean
Public Gsm_CommonRev_End_Start As Boolean
Public Gsm_CommonRev_Cmd As String
Public Gsm_CommonRev_Cmd_Start As Boolean
Public Gsm_CommonRev_Cmd_End As Boolean
Public Gsm_CommonRev_Result As String
Public Gsm_CommonRev_Way As String
Public Gsm_CommonRev_Cmd_Head As Boolean
Public Gsm_RevData_LenStr As String
Public Gsm_RevData_LenDStart As Boolean
Public Gsm_RevData_LenCount As Integer
Public Gsm_RevData_LenDEnd As Boolean
Public Gsm_RevData_LenSCA_Start As Boolean

Public Gsm_RevData_LenSCA_End As Boolean
'"Gsm_MesSenCmd" ,"Gsm_MesSenStr","Gsm_MesInit","gsmnone","Gsm_Reset"
'Public Gsm_RevData_LenInt As Integer

'交叉判断临时变量



'Public Gsm_RevData_LenStr_Bef As String

'Public CommonRev_Data_Bef As Variant
Public Gsm_CommonRev_Head_Bef As Boolean
Public Gsm_CommonRev_Head_Start_Bef As Boolean
Public Gsm_CommonRev_End_Bef As Boolean
Public Gsm_CommonRev_End_Start_Bef As Boolean
Public Gsm_CommonRev_Cmd_Bef As String
Public Gsm_CommonRev_Cmd_Start_Bef As Boolean
Public Gsm_CommonRev_Cmd_End_Bef As Boolean
Public Gsm_CommonRev_Result_Bef As String
'Public Gsm_CommonRev_Way_Bef As String
Public Gsm_CommonRev_Cmd_Head_Bef As Boolean
'交叉判断临时变量
Public Gsm_CommonRev_Stop As Boolean
'"Gsm_MesSenCmd" ,"Gsm_MesSenStr","Gsm_MesInit","gsmnone","Gsm_Reset"
'Public Gsm_RevData_LenInt As Integer

Public Gsm_CommonRev_Cross_Judge As Boolean

Public TempRevHex As String
Public TempRevAsc As String



Public Dir_CommonRev_Way As String


Public TransWay As String   '传输方式　　direct gsm gprs
  
       

Function GetINI(AppName As String, KeyName As String, FileName As String) As String
   Dim RetStr As String
   RetStr = String(10000, Chr(0))
   GetINI = Left(RetStr, GetPrivateProfileString(AppName, ByVal KeyName, "", RetStr, Len(RetStr), FileName))
End Function
Public Sub SaveINI(ByVal AppName As String, ByVal KeyName As String, ByVal lpString As String, ByVal FileName As String)
    Dim StrIniLen As Long
    StrIniLen = WritePrivateProfileString(ByVal AppName, ByVal KeyName, ByVal lpString, ByVal FileName)
End Sub

Function AddSpace(DealStr As String) As String

  Dim LenStr As Long
  Dim DisStr As String
  Dim Txtstrcou As Integer
  
  LenStr = Len(DealStr)
  DisStr = ""
  
  For Txtstrcou = 1 To LenStr
  
  
   DisStr = DisStr & Mid(DealStr, Txtstrcou, 2) & " "
   
  
  Txtstrcou = Txtstrcou + 1
  
  Next Txtstrcou
  
  

   AddSpace = DisStr
End Function

Function Delspace(txtstring As String) As String

    Dim TxtLength As Integer
    Dim DelCounter As Integer
    Dim GetStrchar As String
    Dim Judge As Integer
    
    Judge = 0
    
    TxtLength = Len(txtstring)
    
    For DelCounter = 1 To TxtLength
    
     GetStrchar = Mid(txtstring, DelCounter, 1)
     
     If Judge = 0 Then
          
        If Asc(GetStrchar) <> 32 Then
     
          Delspace = GetStrchar
          Judge = 1
      
         End If
      
      ElseIf Judge = 1 Then
      
          If Asc(GetStrchar) <> 32 Then
          
          Delspace = Delspace & GetStrchar
          
          End If
                    
      End If
      
      
      Next DelCounter


End Function

Function AscToHex(asccode As Integer) As String
   Dim mointer As Integer