Полагаю что тут главное сделать скелет позволяющий посылать AT-команды модему и получать от него ответ. Дальше останется просто разобраться с AT-командами конкретного модема.
Как-же я заблуждался 
.
Продолжаем разговор. Хочу представить мою текущую наработку - класс для формирования PDU для отправки в модем.
Свойства:
DebugMsg[def: False] - True включает вывод сообщений при работе(wscript.echo).
DeliveryReport[def: False] - СМС с уведомлением о доставке(если True)
IsFlashSMS[def: False] - Flash СМС(если True). на моей нокии просто по приходу СМС она сразу открывалась в штатном интерфейсе(блокировка экрана при этом остаётся).
RCPT - телефонный номер адресата в международном формате("+79998887766", можно и "79998887766")
MessageText - текст СМС
SMSC[def: "00"] - номер СМС-центра. Возможные значения:
1. телефонный номер в международном формате("+79037011111", для BeeLine MSK).
2. "00" - брать номер из телефона/SIM-карты(работает не всегда).
3. "" - действует аналогично "00"(на некоторых модемах может работать когда не работает "00").
PartCount - свойство возвращает INTEGER, кол-во частей СМС сообщения. Доступно после задания MessageText. Только для чтения.
TP_VP[def: "00"] - строка содержит байт TP-Validity-Period("время жизни СМСЭ" - время, по истечении которого сообщение в памяти SMSC уничтожается, если SMSC не получил уведомление о доставке сообщения получателем.). В данный момент прописаны значения:
"0B" - Один час…
"1D" - Три часа…
"47" - Шесть часов…
"8F" - Двенадцать часов…
"A7" - Один день…
"C4" - Одна неделя…
"FF" - Максимальный срок хранения…
Значения для TP-VP взяты из ранее упомянутых мануалов. Нашел ещё одну инструкцию(содержит массу информации сверх уже упомянутых статей), в ней описан алгоритм расчёта этого поля:
Формат VP определяется полем VPF (Validity Period Format).
===========================================================================
|Значение VPF | Формат VP | Длина поля VP в байтах |
===========================================================================
| 00b | поле VP отсутствует | 0 |
| 01b | резерв в Siemens, расширенный формат для SonyEricsson | - |
| 10b | поле VP использует относительный формат | 1 |
| 11b | поле VP использует абсолютный формат | 7 |
===========================================================================
При задании относительного формата VP кодируется одним байтом в соответствии со следующей таблицей:
Значение VP, десятичное => Как считать VP
0 .. 143 => (VP + 1) * 5 минут = максимально можно задать 12 часов с шагом 5 минут
144 .. 167 => 12 часов + (VP – 143)*30 минут = максимально можно задать 24 часа
168 .. 196 => (VP – 166) * 1 день = максимально можно задать 30 дней
197 .. 255 => (VP – 192) * 1 неделю = максимально можно задать 63 неделиКак не хватает если уж не тега для таблиц, так хотябы чего-то вроде тега pre - для вывода моноширинным шрифтом с сохранением форматирования...Так и не смог табличку эту выровнять по человечески 
.
Описанный алгоритм не реализовывал.
Да и в класс добавил это поле доступным для указания только потому оно было описано - реально не тестировал, и не слишком представляю практическую пользу для темы топика.
Если честно, есть сомнения в работоспособности поля, т.к. согласно цитируемому алгоритму
Метод только один:
SMS - возвращает двухмерный массив. Первая колонка - длина сообщения(для команды "AT+CMGS="), вторая - PDU строка для скармливания модему.
Код класса:
Class PDU_Encode
' "PDU-режим придумали разработчики - извращенцы. Придумали они его для того, чтобы поиметь мозги тех, кто будет с ним работать."
' (c) StarXXX
Private MaxLen7bit, MaxLen8bit, MaxLen16bit
Private PDUType ' Тип сообщения. Поле флагов. В некоторых источниках упоминается как SMS-SUBMIT-PDU
' для исходящего СМС достаточно первых двух бит равно "01"
Private TPMR ' TP-Message-Reference - используется для длинных СМС
Private TPPID ' TP-Protocol ID
Private TPDCS ' TP-Data-Coding-Scheme – Схема кодирования данных. Указывает, в каком формате представлено сообщение.
Private TPVP ' TP-Validity-Period — время действия сообщения
Private Recipient ' номер получателя
Private SMS_Centr ' номер СМС-центра
Private MsgText ' текст СМС(тот что видится на экране телефона)
Private SMSLen ' длина TPDU(без SCA) - указывается в AT+CMGS=LEN
Private FlashSMS ' будем формировать всплывающую СМС(aka Flash)
Private DelivRep ' DeliveryReport
Private IsUDH ' требуется байт UDH(обычно для длинных СМС)
Private IsTPVP ' требуется ли байт TP-VP
Private SMSPartCount ' число частей длинной СМС
Private SMSPartArr ' массив содержащий части СМС
Private IsCyr ' маркер использования в СМС киррилицы
Private LongPartUSCLim 'USC-2, (140bit – 6byte под UDH) с 8-битным указателем, для сообщения остаётся 134 байта или 67 символов
Private LongPart7bLim '7-бит, (140bit – 7byte под UDH) с 17-битным указателем, для сообщения остаётся 1133 байта или 152 символов
Private IED_index 'указатель каскадных сообщений
Private Dbg ' включение дополнительных сообщений по ходу работы скрипта
Private Sub Class_Initialize
MaxLen7bit = 160 'за счёт упаковки 7-bit кодировки в 8-bit строку
MaxLen8bit = 140 'только если передавать не пользуясь PDU - одиночные английские СМС
'теоретически, если PDU позволяет использовать 8-bit кодировку, можно и по 140 символов резать,
'но смысла уже нет - с упаковкой разобрался.
MaxLen16bit = 70 'передача в юникоде, соотв. 140 байт делим пополам - остаётся только 70 символов
PDUType = "01" ' Исходящее сообщение
TPMR = "00" ' Короткое СМС, байт нулевой
TPPID = "00" ' TP-Protocol ID, описание пока не извесно
TPDCS = "08" ' 08h: кодировка UCS2 (тот же Unicode), 70 знаков, 2 байта на символ
TPVP = "00" ' TP-Validity-Period — время действия сообщения (если сообщение не будет получено абонентом в течение
' этого времени, SMS-центр его удалит).
' Если PDUType = "01"|"21"|"41"|"61", то это поле в TPDU опускается
Recipient = ""
SMS_Centr = ""
MsgText = ""
SMSLen = 0
FlashSMS = False
DelivRep = False
IsUDH = False
SMSPartCount = 0
Redim SMSPartArr(1, 0)
IsCyr = False
LongPartUSCLim = 67
LongPart7bLim = 152
IED_index = "" 'тут хранится "Номер-ссылка" - случайное число. одинаковое для всех частей одного длинного СМС
Dbg = False
End Sub
'############################################################################
'### Class Properties ####
'############################################################################
Public Property Let DebugMsg(param) ' тип СМС(всплывающая или обычная)
If Not VarType(param)= 11 Then
Err.Raise 60601, "PDU", "Incorrect Data Type. Need Boolean!"
Exit Property
End If
If param Then
Dbg = True
Else
Dbg = False
End If
End Property
Public Property Get DebugMsg()
DebugMsg = Dbg
End Property
'############################################################################
Public Property Let IsFlashSMS(param) ' тип СМС(всплывающая или обычная)
If Not VarType(param)= 11 Then
Err.Raise 60602, "PDU", "Incorrect Data Type. Need Boolean!"
Exit Property
End If
If param Then
FlashSMS = True
Else
FlashSMS = False
End If
End Property
Public Property Get IsFlashSMS()
IsFlashSMS = FlashSMS
End Property
'############################################################################
Public Property Let TP_VP(param) ' Время жизни СМС
Select Case param 'известные допустимые значения параметра
Case "0B" ' Один час…
IsTPVP = True
Case "1D" ' Три часа…
IsTPVP = True
Case "47" ' Шесть часов…
IsTPVP = True
Case "8F" ' Двенадцать часов…
IsTPVP = True
Case "A7" ' Один день…
IsTPVP = True
Case "C4" ' Одна неделя…
IsTPVP = True
Case "FF" ' Максимальный срок хранения…
IsTPVP = True
Case Else
Err.Raise 60603, "PDU", "Incorrect PDU Type value."
Exit Property
End Select
TPVP = param
End Property
Public Property Get TP_VP()
TP_VP = TPVP
End Property
'############################################################################
Public Property Let RCPT(param) ' номер получателя в международном формате
Dim SString
SString = Trim(param)
Dim f_regEx, f_Match, f_Matches, Shablon
Set f_regEx = New RegExp
f_regEx.Ignorecase = True
f_regEx.Global = True
f_regEx.Multiline = True
f_regEx.Pattern = "\+[\d]{11,}"
If f_regEx.Test(SString) Then
Set f_Matches = f_regEx.Execute(SString)
Recipient = Replace(f_Matches(0).Value,"+","")
Else
f_regEx.Pattern = "[\d]{11,}"
If f_regEx.Test(SString) Then
Set f_Matches = f_regEx.Execute(SString)
Recipient = f_Matches(0).Value
Else
Err.Raise 60604, "PDU", "Incorrect RCPT number."
Exit Property
End If
End If
End Property
Public Property Get RCPT()
RCPT = Recipient
End Property
'############################################################################
Public Property Let SMSC(param) ' номер СМС-центра в международном формате
Dim SString
SString = Trim(param) ' не указываем номер SMSC при формировании PDU
If SString = "" Then
SMS_Centr = SString
Exit Property
End If
If SString = "00" Then ' заменяем номер SMSC на "00" при формировании PDU
'(номер СМС-центра должен подхватываться модемом с симки)
SMS_Centr = SString
Exit Property
End If
Dim f_regEx, f_Match, f_Matches, Shablon
Set f_regEx = New RegExp
f_regEx.Ignorecase = True
f_regEx.Global = True
f_regEx.Multiline = True
f_regEx.Pattern = "\+[\d]{11,}"
If f_regEx.Test(SString) Then
Set f_Matches = f_regEx.Execute(SString)
SMS_Centr = Replace(f_Matches(0).Value,"+","")
Else
f_regEx.Pattern = "[\d]{11,}"
If f_regEx.Test(SString) Then
Set f_Matches = f_regEx.Execute(SString)
SMS_Centr = f_Matches(0).Value
Else
Err.Raise 60605, "PDU", "Incorrect SMS-Centr number."
Exit Property
End If
End If
End Property
Public Property Get SMSC()
SMSC = SMS_Centr
End Property
'############################################################################
Public Property Let MessageText(param) ' текст СМС-ки
MsgText = Trim(param) ' нефиг пробелы просто так слать :)
If len(MsgText) = 0 Then
Err.Raise 60606, "PDU", "Message text is empty!"
Exit Property
End If
Dim i ', IsCyr
For i = 1 To len(MsgText) ' ищем символы из верхнего диапазона кодов ASCII
If Asc(Mid(MsgText, i, 1)) > 127 Then IsCyr = True : Exit For
Next
If IsCyr And len(MsgText) > MaxLen16bit Then 'USC-2
If len(MsgText) \ LongPartUSCLim = len(MsgText) / LongPartUSCLim Then
SMSPartCount = len(MsgText) \ LongPartUSCLim
Else
SMSPartCount = len(MsgText) \ LongPartUSCLim + 1
End If
Elseif Not IsCyr And len(MsgText) > MaxLen7bit Then '7-bit->8-bit
If len(MsgText) \ LongPart7bLim = len(MsgText) / LongPart7bLim Then
SMSPartCount = len(MsgText) \ LongPart7bLim
Else
SMSPartCount = len(MsgText) \ LongPart7bLim + 1
End If
Else
SMSPartCount = 1
End If
End Property
Public Property Get MessageText()
MessageText = MsgText
End Property
'############################################################################
Public Property Let DeliveryReport(param) ' нужен ли отчёт о доставке?
If VarType(param) = 11 Then
DelivRep = param
Else
Err.Raise 60607, "PDU", "Incorrect Data Type. Need Boolean!"
Exit Property
End If
End Property
Public Property Get DeliveryReport()
DeliveryReport = DelivRep
End Property
'############################################################################
Public Property Let PartCount(param) ' считаем кол-во частей СМС
'Процедура создана для того чтобы в дереве процедур PSPad-а отображалось св-во PartCount :)
End Property
Public Property Get PartCount() ' считаем кол-во частей СМС
PartCount = SMSPartCount
End Property
'############################################################################
'### Class Procedures ####
'############################################################################
Private Function TP_DA(num) ' вычисление поля TP_DA (адресат)
Dim NumLen, NumType
NumType = "91" 'международный формат
If len(num)=0 Then
Err.Raise 60605, "PDU", "Incorrect RCPT number!"
Exit Function
End If
'длина номера(цифр без символа F) в хексе
NumLen = Hex(len(num))
If len(NumLen) = 1 Then NumLen = "0" & NumLen
If len(num)\2 = len(num)/2 Then
TP_DA = num
Else ' Нечётное число символов
TP_DA = num & "F"
End If
Dim i, str
'переворачиваем всё
For i = 2 To len(TP_DA) step 2
str = str & Mid(TP_DA, i, 1) & Mid(TP_DA, i-1, 1)
Next
TP_DA = NumLen & NumType & str
End Function
'############################################################################
Private Function SCA() ' вычисление поля SCA (SMS-центр)
If SMS_Centr = "" Then
SCA = "00"
Else
Dim SString, NumLen, NumType
NumType = "91" 'международный формат
If len(SMS_Centr)\2 = len(SMS_Centr)/2 Then
SCA = SMS_Centr
Else ' Нечётное число символов
SCA = SMS_Centr & "F"
End If
Dim i, str
'переворачиваем всё
For i = 2 To len(SCA) step 2
str = str & Mid(SCA, i, 1) & Mid(SCA, i-1, 1)
Next
'добавляем к номеру SMS-центра тип номера
SCA = NumType & str
'число бит получившейся строки, в хексе
NumLen = Hex(len(SCA)/2)
If len(NumLen) = 1 Then NumLen = "0" & NumLen
SCA = NumLen & SCA
End If
End Function
'############################################################################
Private Sub Str2USC2Hex() 'кодирование сообщения
Dim i, str, j, Code
For i = 0 To SMSPartCount - 1
str = SMSPartArr(1, i)
SMSPartArr(1, i) = ""
For j = 1 To len(str)
Code = Hex(AscW(Mid(str, j, 1)))
'leading zero:
If len(Code) < 4 Then Code = String(4 - len(Code), "0") & Code
' If len(Code) = 1 Then Code = "000" & Code 'управляющие символы
' If len(Code) = 2 Then Code = "00" & Code 'символы ASCII - первый бит 00
' If len(Code) = 3 Then Code = "0" & Code 'кирилица начинается с 0400
SMSPartArr(1, i) = SMSPartArr(1, i) & Code
Next
Next
End Sub
'############################################################################
Public Function SMS() 'формируем текст СМС, параллельно считаем длину TP-DU
Call TPDU() 'формируем TP-DU
If Dbg Then wscript.echo "SMSPartCount = " & SMSPartCount
If Dbg Then wscript.echo "SCA = " & SCA
For i = 0 To SMSPartCount - 1
If Dbg Then wscript.echo SMSPartArr(1, i)
SMSPartArr(1, i) = SCA & SMSPartArr(1, i)
Next
SMS = SMSPartArr
MsgText = ""
End Function
'############################################################################
Private Sub TPDU() ' сформированная строка для передачи момеду(одиночная СМС)
' 1. определиться с наличием кирилицы -> кодировка(TP_DSC)
' 2. если кодировка 7-bit, то TP-UDL равен кол-ву символов сообщения
' если кодировка UCS2, то TP-UDL равен кол-ву байт сообщения
Dim TPUDL ' длина текста сообщения
Dim TPUD ' закодированный в 8-байтную строку текст сообщения
If IsCyr And SMSPartCount = 1 Then
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
If Dbg Then wscript.echo "PDU UCS2, single"
' задаём значение байта кодировки:
If FlashSMS Then
TPDCS = "18"
Else
TPDCS = "08"
End If
Redim SMSPartArr(1, SMSPartCount - 1)
For i = 0 To SMSPartCount - 1
SMSPartArr(1, i) = MsgText
SMSPartArr(0, i) = 2 * len(SMSPartArr(1, i)) ' для USC2 длина считается в байтах!
' в HEX переведём в самом конце, после прибавления длины UDH
''If len(SMSPartArr(0, i)) = 1 Then SMSPartArr(0, i) = "0" & SMSPartArr(0, i)
If Dbg Then wscript.echo "SMSPartArr(0, " & i & ") = " & SMSPartArr(0, i) & "; SMSPartArr(1, " & i & ") = " & SMSPartArr(1, i)
Next
Call Str2USC2Hex() ' выполняем кодирование текста
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Elseif IsCyr And SMSPartCount > 1 Then
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
If Dbg Then wscript.echo "PDU UCS2, long"
' задаём значение байта кодировки:
If FlashSMS Then
TPDCS = "18"
Else
TPDCS = "08"
End If
Redim SMSPartArr(1, SMSPartCount - 1)
For i = 0 To SMSPartCount - 1
If i < SMSPartCount - 1 Then
SMSPartArr(1, i) = Left(MsgText, LongPartUSCLim) '(140 – 6 под UDH) с 8-битным указателем
SMSPartArr(0, i) = 2 * len(SMSPartArr(1, i))
' в HEX переведём в самом конце, после прибавления длины UDH
MsgText = Right(MsgText, len(MsgText) - LongPartUSCLim)
Else
SMSPartArr(1, i) = Left(MsgText, LongPartUSCLim)
SMSPartArr(0, i) = 2 * len(SMSPartArr(1, i))
' в HEX переведём в самом конце, после прибавления длины UDH
End If
If Dbg Then wscript.echo "SMSPartArr(0, " & i & ") = " & SMSPartArr(0, i) & "; SMSPartArr(1, " & i & ") = " & SMSPartArr(1, i)
Next
Call Str2USC2Hex()
IsUDH = True
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
Elseif Not IsCyr And SMSPartCount = 1 Then
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
If Dbg Then wscript.echo "7-bit->8-bit PDU, single"
' задаём значение байта кодировки:
If FlashSMS Then
TPDCS = "10"
Else
TPDCS = "00"
End If
Redim SMSPartArr(1, SMSPartCount - 1)
For i = 0 To SMSPartCount - 1
SMSPartArr(1, i) = MsgText
SMSPartArr(0, i) = len(SMSPartArr(1, i))
' в HEX переведём в самом конце, после прибавления длины UDH
If Dbg Then wscript.echo "SMSPartArr(0, " & i & ") = " & SMSPartArr(0, i) & "; SMSPartArr(1, " & i & ") = " & SMSPartArr(1, i)
Next
' TPUDL = Hex(len(MsgText)) 'TP-User-Data-Length – длина сообщения(символов) в HEX.
' TPUD = Encode7bit(MsgText) 'TP-User-Data – непосредственно текст SMS-сообщения
Call Encode7bit() ' выполняем кодирование текста
Elseif Not IsCyr And SMSPartCount > 1 Then
'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
If Dbg Then wscript.echo "7-bit->8-bit, long"
' задаём значение байта кодировки:
If FlashSMS Then
TPDCS = "10"
Else
TPDCS = "00"
End If
' 16-битный указатель, предел 152 символов на часть
Redim SMSPartArr(1, SMSPartCount - 1)
For i = 0 To SMSPartCount - 1
If i < SMSPartCount - 1 Then
SMSPartArr(1, i) = Left(MsgText, LongPart7bLim)
SMSPartArr(0, i) = len(SMSPartArr(1, i))
' в HEX переведём в самом конце, после прибавления длины UDH
MsgText = Right(MsgText, len(MsgText) - LongPart7bLim)
Else
SMSPartArr(1, i) = Left(MsgText, LongPart7bLim)
SMSPartArr(0, i) = len(SMSPartArr(1, i))
' в HEX переведём в самом конце, после прибавления длины UDH
End If
If Dbg Then wscript.echo "SMSPartArr(0, " & i & ") = " & SMSPartArr(0, i) & "; SMSPartArr(1, " & i & ") = " & SMSPartArr(1, i)
Next
IsUDH = True
Call Encode7bit() ' выполняем кодирование текста
'<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
End If
Dim TPDA
TPDA = TP_DA(Recipient) 'TP-Destination-Address – Номер телефона получателя сообщения
' Определимся с типом сообщения
Call PDU_Type()
Dim TPDU
If Dbg Then wscript.echo "PDU-Type = " & PDUType
For i = 0 To SMSPartCount - 1
If Dbg Then wscript.echo "Long SMS; Part [" & i + 1 & "]/[" & SMSPartCount & "]"
' TP-UDL: прибавляем к длине закодированного сообщения длину заголовка UDH
If IsCyr Then ' длина текста указывается в байтах для USC-2 и в символах для 7-bit!!!
' Для USC2 длина равна числу символов *2. Удвоение длины делается в момент формирования массива SMSPartArr!!!
If IsUDH Then ' для длинных СМС учитываем блок UDH
TPUDL = GetByte(SMSPartArr(0, i) + 6, 1) ' для USC-2 длина вдвое больше кол-ва символов(2 байта на символ).
' указатель однобайтний и заголовок UDH имеет длину 6 byte
Else
TPUDL = GetByte(SMSPartArr(0, i), 1)
End If
Else
If IsUDH Then ' для длинных СМС учитываем блок UDH
TPUDL = GetByte(SMSPartArr(0, i) +8, 1) ' при +7 теряется последний символ каждой СМС...
' при +8 длинные СМС идут нормально, но хотелось бы понять причину...
Else
TPUDL = GetByte(SMSPartArr(0, i), 1)
End If
End If
TPUD = SMSPartArr(1, i)
' по некоторым данным, для длинного СМС должно иметь разное значение среди остальных кусков
If SMSPartCount > 1 Then
TPMR = GetByte(i + 1, 1)
End If
Dim UDHtmp
Select Case PDUType
Case "01", "21" 'исх. сообщ.; \A + отчёт о доставке
If Dbg Then wscript.echo "01 TPDU без SCA =>" & PDUType & " " & TPMR & " " & TPDA & " " & TPPID & " " & TPDCS & " " & TPUDL & " " & TPUD
TPDU = PDUType & TPMR & TPDA & TPPID & TPDCS & TPUDL & TPUD
If Dbg Then wscript.echo "TPDU без SCA =>" & TPDU
Case "41", "61" 'исх. сообщ. + UDH; \A + отчёт о доставке !!!!!!!!!!!!!!!!!!!
UDHtmp = UDH(i+1)
If Dbg Then wscript.echo "41 TPDU без SCA =>" & PDUType & " " & TPMR & " " & TPDA & " " & TPPID & " " & TPDCS & " " & TPUDL & " " & UDHtmp & " " & TPUD
TPDU = PDUType & TPMR & TPDA & TPPID & TPDCS & TPUDL & UDHtmp & TPUD
SMSPartArr(1, i) = TPDU
If Dbg Then wscript.echo "TPDU без SCA =>" & TPDU
Case "11", "31" 'исх. сообщ. + TP-VP; \A + отчёт о доставке
If Dbg Then wscript.echo "11 TPDU без SCA =>" & PDUType & " " & TPMR & " " & TPDA & " " & TPPID & " " & TPDCS & " " & TPVP & " " & TPUDL & " " & TPUD
TPDU = PDUType & TPMR & TPDA & TPPID & TPDCS & TPVP & TPUDL & TPUD
If Dbg Then wscript.echo "51 TPDU без SCA =>" & TPDU
Case "51", "71" 'исх. сообщ. + UDH + TP-VP; \A + отчёт о доставке
UDHtmp = UDH(i+1)
If Dbg Then wscript.echo "11 TPDU без SCA =>" & PDUType & " " & TPMR & " " & TPDA & " " & TPPID & " " & TPDCS & " " & TPVP & " " & TPUDL & " " & UDHtmp & " " & TPUD
TPDU = PDUType & TPMR & TPDA & TPPID & TPDCS & TPVP & TPUDL & UDHtmp & TPUD
If Dbg Then wscript.echo "51 TPDU без SCA =>" & TPDU
End Select
SMSPartArr(1, i) = TPDU
SMSPartArr(0, i) = len(SMSPartArr(1, i))/2
If Dbg Then wscript.echo "SMSPartArr(0, " & i & ") = " & SMSPartArr(0, i) & "; SMSPartArr(1, " & i & ") = " & SMSPartArr(1, i)
If Dbg Then wscript.echo "IED_index = " & IED_index
Next
End Sub
'############################################################################
Private Function UDH(k)
Dim UDHL, IEI, IEDL, IED
' IEI
' вариантов использования много, для СМС есть два значение:
' «00h» – Связанное короткое сообщение. 8-битный указатель…
' «08h» – Связанное короткое сообщение. 16-битный указатель…
Dim b1_b2, b3, b4
' b1 & b2 - при IEI="08", при "00" остаётся только b1
' составляют указатель каскадных сообщений (случайное число от 0 до 255|65535). Для всех частей длинной СМС должны быть одинаковы
' b3 - число сегментов сообщения
' b4 - порядковый номер сообщения
b3 = GetByte(SMSPartCount, 1)
If Dbg Then wscript.echo "b3 = " & b3
b4 = GetByte(k, 1)
If Dbg Then wscript.echo "b4 = " & b4
If Not IsCyr Then 'ASCII
UDHL = "06" 'User Data Header Length
IEI = "08" 'Information Element Identifier
IEDL = "04" 'Information Element Data Length
'Т.к. указатель одинаков для всех частей, то генерим при первом вызове процедуры
If IED_index = "" Then IED_index = Rand2b
Else 'USC-2
UDHL = "05" 'User Data Header Length
IEI = "00" 'Information Element Identifier
IEDL = "03" 'Information Element Data Length
If IED_index = "" Then IED_index = Rand1b
End If
b1_b2 = IED_index
If Dbg Then wscript.echo "b1_b2 = " & b1_b2
'UDH = UDHL + IEI + IEDL + IED
IED = b1_b2 & b3 & b4
UDH = UDHL & IEI & IEDL & IED
If Dbg Then wscript.echo "UDH = " & UDH
End Function
'############################################################################
Private Function GetByte(str, size) ' получение байта или двух...
GetByte = Hex(str)
If len(GetByte) < 4 Then
If size = 1 Then GetByte = String(2 - len(GetByte), "0") & GetByte
If size = 2 Then GetByte = String(4 - len(GetByte), "0") & GetByte
End If
End Function
'############################################################################
Private Function Rand1b() ' рандомное однобайтовое число
Randomize
Do
Rand1b = (1000 * Rnd) \ 1
Loop While Rand1b > 255
Rand1b = Hex(Rand1b)
If len(Rand1b) = 1 Then Rand1b = "0" & Rand1b
End Function
'############################################################################
Private Function Rand2b() ' рандомное двубайтовое число
Randomize
Do
Rand2b = (1000 * Rnd) \ 1
Loop While Rand2b > 65535
Rand2b = Hex(Rand2b)
If len(Rand2b) < 4 Then Rand2b = String(4-len(Rand2b), "0") & Rand2b
End Function
'############################################################################
Private Sub PDU_Type() ' определяемся с типом СМС(PDU-Type)
If Not IsTPVP And Not DelivRep And Not IsUDH Then
PDUType = "01"
Elseif IsTPVP And Not DelivRep And Not IsUDH Then
PDUType = "11"
Elseif Not IsTPVP And DelivRep And Not IsUDH Then
PDUType = "21"
Elseif IsTPVP And DelivRep And Not IsUDH Then
PDUType = "31"
Elseif Not IsTPVP And Not DelivRep And IsUDH Then
PDUType = "41"
Elseif IsTPVP And Not DelivRep And IsUDH Then
PDUType = "51"
Elseif Not IsTPVP And DelivRep And IsUDH Then
PDUType = "61"
Elseif IsTPVP And DelivRep And IsUDH Then
PDUType = "71"
End If
End Sub
'############################################################################
'### Упаковка 7-bit текста в 8-bit строку ###
'############################################################################
Private Sub Encode7bit()
Dim arr7b() 'массив для 7bit кодов
Dim arr8b() 'массив для кодирования в 8bit
Dim j, str
For j = 0 To SMSPartCount - 1
str = SMSPartArr(1, j)
' "набиваем" 7bit массив:
Dim i : i = 0
Dim bCode : bCode = ""
Do While len(str) <> 0
bCode = dec2bin(Asc(Left(str, 1))) ' ASCII код символа в двоичном виде
Redim Preserve arr7b(i) ' перезадаём размер массива(кроме первого шага - увеличение размерности на 1)
If len(bCode) < 7 Then ' дополняем код нулями до 7 бит
bCode = String(7 - len(bCode), "0") & bCode
End If
If i = 150 Then
bCode = bCode
End If
arr7b(i) = bCode
str = Right(str, len(str) - 1) 'откусываем от строки один символ слева
i = i + 1
Loop
' В результате, имеем на выходе массив, каждый элемент которого - код символа в двоичном виде(7 бит).
Redim arr8b(UBound(arr7b)) 'задаём размер как для 7-бит массива
' "сжимаем" 7-битную строку в 8-битную:
Dim DlinaKuska
' проходим по таблице, на каждом 8-ом элементе(i=7...15... ) "пропускаем ход"
' в конце "очищаем" массив от пустых значений
' внутри "круга" "откусывается" у следущего элемента массива: i + 1 - (i\8) * 8
' внутри "круга" "остаётся" у следущего элемента массива: 7 - (i + 1 - (i\8) * 8)
' "круг" - период за который при упаковке "исчезает" 1 байт - на пальцах сложно объяснить, см. "SendSMS_PDU_Part_1.pdf"
For i = 0 To UBound(arr7b)
If i < UBound(arr7b) Then ' пока не дошли до последнего элемента массива...
If (i+1)\8 = (i+1)/8 Then 'каждый 8-ой элемент(i=7, i=15 ets) нулевой
arr8b(i) = ""
Else
DlinaKuska = i + 1 - (i\8) * 8 'длина = (индекс элемента + 1) за вычетом полных "кругов"
' формируем текущий байт приписывая к текущему 7-битному часть следующего 7-битного
arr8b(i) = Right(arr7b(i + 1), DlinaKuska) & arr7b(i)
' укорачиваем следующий 7-битный элемент на величину "позаимствованных" данных
arr7b(i+1) = Left(arr7b(i+1), 7 - DlinaKuska)
End If
Else
' если элемент последний, то просто дорисовываем недостающие нули(единообразия ради)
' конечно если элемент не пустой...
If len(arr7b(i)) <> 0 Then arr8b(i) = String(8 - len(arr7b(i)), "0") & arr7b(i)
End If
Next
'удаляем пустые элементы(можно бы и без этого, но так красивее :)
Call CompactArray(arr8b)
'формируем строку сообщения в Hex:
Dim str8b_h, substr
str8b_h = ""
For i = 0 To UBound(arr8b)
substr = Hex(bin2dec(arr8b(i)))
If len(substr) = 1 Then substr = "0" & substr
str8b_h = str8b_h & substr
Next
SMSPartArr(1, j) = str8b_h
Next
End Sub
'############################################################################
Private Sub CompactArray(Byref arr) ' очистка динамического одномерного массива от пустых элементов
Dim i
' помечаем пустые элементы:
For i = 0 To UBound(arr)
If arr(i) = "" Then arr(i) = "del"
Next
Dim arrNew
' формируем массив без удаляемых ячеек:
arrNew = Filter(arr, "del", False)
' переразмериваем переданный в процедуру массив(без сохранения данных)
Redim arr(UBound(arrNew))
' заполняем его отфильтованными элементами:
For i = 0 To UBound(arrNew)
arr(i) = arrNew(i)
Next
End Sub
'############################################################################
Private Function bin2dec(num) ' кодирование из двоичной в десятичную систему
Dim i : i = 0
bin2dec = 0
Do While len(num) <> 0
bin2dec = bin2dec + CInt(Right(num, 1))*2^i
num = left(num, len(num) - 1) 'откусываем один символ справа
i = i + 1
Loop
End Function
'############################################################################
Private Function dec2bin(num) ' кодирование из десятичную в двоичной систему
Dim i : i = 0
dec2bin = ""
Dim tmp, ost
Do While num <> 0
dec2bin = CStr(num - 2 * (num \ 2)) & dec2bin
num = num\2
Loop
End Function
End ClassПример использования:
Option Explicit
Dim MSComm
Set MSComm = WScript.CreateObject("MSCommLib.MSComm", "Modem_")
With MSComm
.CommPort = 8
.Handshaking = 0 'ComNone Нет подтверждения связи (Значение по умолчанию)
.Settings = "9600,N,8,1" 'Установка скорости в бодах,контроль по четности,число битов данных,число стоповых битов
.InputLen = 0 'Используем весь буфер(при запросе возвращается ВЕСЬ текущий буфер)
.Rthreshold = 1
End With
Dim ComState 'статус выполнения команды
Dim wPortResp 'ожидаемый ответ модема
Dim PortResp 'ответ модема
Dim LastCommand 'последняя отданая команда(для отладки)
PortResp = vbNullString
ComState = vbNullString
' Открываем порт:
If Not MSComm.PortOpen Then MSComm.PortOpen = True
' Готовим объект
Dim PDU
Set PDU = New PDU_Encode
' Посылаем команды в порт:
' пинганули...
SendATCommand "AT", "OK"
' узнаем номер СМС-центра
SendATCommand "AT+CSCA?", "OK"
' задаём параметры для кодирования в PDU
With PDU
.RCPT = "+79998887766"
.SMSC = GetSMSC(PortResp)
.MessageText = "Да не беги ты! Видишь, сзади две," & vbCrLf & _
"И обе из порядочного дома." & vbCrLf & _
"Одна из них с соседями в родстве," & vbCrLf & _
"И потому мы шапочно знакомы." & vbCrLf & _
"Раскланяемся с ними, подойдем" & vbCrLf & _
"И совершим прогулку, вчетвером."
End With
' Задаём формат СМС сообщения:
SendATCommand "AT+CMGF=0", "OK"
Dim arr, i
arr = PDU.SMS ' получаем части для скармливания модему
For i = 0 To PDU.PartCount - 1
' Начинаем отправку сообщения:
SendATCommand "AT+CMGS=" & arr(0,i), ">"
' передаём текст сообщения и отправляем:
SendATCommand arr(1,i) & Chr(26), "OK"
Next
' Закрываем порт:
MSComm.PortOpen = False
Wscript.Quit 0
Sub SendATCommand(command, WaitFor) 'отправка команд в модем
ComState = vbNullString
If InStr(WaitFor, ">") <> 0 Then
wPortResp = WaitFor
Else
wPortResp = WaitFor & Chr(13) & Chr(10)
End If
LastCommand = command
MSComm.Output = command & Chr(13) & Chr(10)
Dim i : i = 0
Dim iLim : iLim = 20
Do While ComState = vbNullString
wscript.echo i & "..."
wscript.sleep 1000
i = i + 1
If i > iLim Then
wscript.echo "время вышло"
wscript.quit(0)
End If
Loop
End Sub
Sub Modem_OnComm() 'отслеживание событий на COM-порте
Select Case MSComm.CommEvent
Case 2 'comEvReceive
PortResp = MSComm.Input
If InStr(PortResp, LastCommand) <> 0 Then wscript.echo LastCommand
If InStr(PortResp, wPortResp) <> 0 Then
'wscript.echo PortResp
wscript.echo "Команда " & LastCommand & " выполнена успешно."
ComState = "OK"
End If
If InStr(PortResp, "ERROR") <> 0 Then
wscript.echo "Команда " & LastCommand & " вызвала ошибку: " & vbCrLf & PortResp
ComState = "ERROR"
End If
End Select
End Sub
Function GetSMSC(resp) 'получение номера СМС-центра
Dim SString, NumLen, NumType
SString = Trim(resp)
Dim f_regEx, f_Match, f_Matches, Shablon
Set f_regEx = New RegExp
f_regEx.Ignorecase = True
f_regEx.Global = True
f_regEx.Multiline = True
f_regEx.Pattern = "\+[\d]+"
If f_regEx.Test(SString) Then
Set f_Matches = f_regEx.Execute(SString)
GetSMSC = f_Matches(0).Value
Else
Exit Function
End If
End Function