ارسال پیامک فارسی با دستورات AT

[Reza Safa]

با سلام
من ارسال پیامک به صورت فارسی را با استفاده از دستورات AT نیاز دارم
گفتنی است که در این سایت جستجو صورت گرفته و نتیجه برای حل این مساله نبوده است
لازم به ذکر است که از OCX , DLL معروف که در سایت ذکر شده نمی خواهم استفاده کنم
فقط وفقط دستورات AT

[sina_saravi1]

اتفاقا منم نیاز دارم

[sina_saravi1]

روش استفادش رو هم میگفتین خیلی خب بود

[M.KH-SH]

میشه یک پروژه بدی
من الان چند وقت هست دنبال میگردم که هم بتونم اس ام اس بزنم و هم بگیرم از طریق کامپیوتر

[Reza Safa]

خواهشن کسی در مورد این سوال کمک کنه

[arash020]

سلام
باید با PDU emcoding , decoding آشنا بشی
یه کم درموردشون تو سایت های زبان اصلی و فارسی تحقیق کن
من هم دنبالش هستم ولی کار چنذلن راحتی نیست
اگه با قالب و انواع و روش های کدگذاری و گشایی pdu آشنا شی متوجه میشی
هیچی غیرممکن نیس اونم برای ایرانی
موافقی ابا هم اون ocx رو طراحی کنیم
یه سری به http://www.eaglevb.blogfa.com/ بزن
یه نمونه برنامه کوچیک همراه راهنمای کامل دستورات at هست گذاشتم شاید مفیدت باشه

[sina_saravi1]

ولی من هر چی بیشتر پی گیر این موضوع شدم دیدم ارزش نداره وقتمون رو برای GSM Modem هدر بدیم
چون سرعتش خیلی پایینه و محدودیتش بالا!
به نظر من این گزینه رو باید بی خیال شیم و بریم دنبال گزینه های بهتر مثل وب سرویس ها

[Reza Safa]

راه حل pdu کردن پیفام sms
البته باید از دوست عزیزم دانیال تشکر کنم که در این زمینه کمکم کرد
http://www.gsm-modem.de/sms-pdu-mode.html
Class pduss


Public Function IsValidPhone(ByVal PhoneNo As String) As Boolean
IsValidPhone = False

Dim S As String
S = PhoneNo
If Len(S) < 3 Or Len(S) > 20 Then Exit Function
Dim L As Integer
If Left(PhoneNo, 1) = "+" Then S = Right(PhoneNo, Len(PhoneNo) - 1)
For L = 1 To Len(S)
If Not ((IsNumeric(Mid(S, L, 1))) Or (Mid(S, L, 1) = "p")) Then Exit Function
Next
IsValidPhone = True

End Function
Public Function Is7Bit(ByVal Str As String) As Boolean
Dim S As String
Dim L As Integer
Dim L2 As Long
Dim B As Boolean


Is7Bit = False
If Str = "" Then Exit Function
If IsUTF8(Str) Then
B = False
For L = 1 To Len(Str)
If Not (B) Then
S = Mid(Str, L, 1)
L2 = (AscW(S) And &H80)
If L2 <> 0 Then B = True
End If ' if not b
Next
Is7Bit = Not (B)
End If
End Function

Public Function IsUTF8(ByVal Str As String) As Boolean
Dim S As String
Dim L As Integer
Dim L2 As Long
Dim B As Boolean


IsUTF8 = False
If Str = "" Then Exit Function
B = False
For L = 1 To Len(Str)
'If Not (B) Then
S = Mid(Str, L, 1)
If AscW(S) < 0 Then Exit Function
L2 = (AscW(S) And &HFF00) \ &H100
If L2 <> 0 Then Exit Function
'End If ' if not b
Next
IsUTF8 = True

End Function
Public Function IsHexDigit(ByVal Str As String) As Boolean
Dim S As String
Dim L As Integer
Dim B As Boolean
Dim B2 As Boolean

IsHexDigit = False
If Str = "" Then Exit Function
B = False
For L = 1 To Len(Str)
If Not (B) Then
S = Mid(Str, L, 1)
B2 = False
If (Asc(S) >= Asc("0")) And (Asc(S) <= Asc("9")) Then B2 = True
If (Asc(UCase(S)) >= Asc("A")) And (Asc(UCase(S)) <= Asc("F")) Then B2 = True
B = Not (B2)
End If ' if not b
Next
IsHexDigit = Not (B)
End Function

Public Function HexChar(ByVal N As Long) As String
If (Len(Hex(N)) Mod 2 <> 0) Then HexChar = "0" & Hex(N) Else HexChar = Hex(N)
End Function

Public Function Char2Hex(ByVal Str As String) As String
Dim S As String

Dim hs As Long
Dim H As Long
Dim L As Long
Char2Hex = ""
If Str = "" Then Exit Function
S = Mid(Str, 1, 1)
hs = AscW(S)
If hs < 0 Then hs = &H10000 + hs
H = (hs And &HFF00) \ &H100
L = hs And &HFF
Char2Hex = HexChar(H) & HexChar(L)
'Char2Hex = HexChar(AscW(S))
End Function
Public Function Phone_IsUCS(ByVal S As String) As Boolean

If Len(S) < 10 Then
Phone_IsUCS = False
Exit Function
End If

If (Left(S, 2) = "80") And (UCase(Right(S, 4)) = "FFFF") Then
Phone_IsUCS = IsHexDigit(S)
Else
Phone_IsUCS = False
End If
End Function

Public Function Phone_Str2UCS(ByVal Str As String) As String
'add 80 & ffff
Dim S As String
Dim L As Integer
Phone_Str2UCS = ""
S = ""
If Str = "" Then Exit Function
For L = 1 To Len(Str)
S = S & Char2Hex(Mid(Str, L, 1))
Next
Phone_Str2UCS = "80" & S & "FFFF"

End Function

Public Function HexDigitVal(ByVal H As String) As Integer
HexDigitVal = 0
If (Len(H) > 1) Or (H = "") Then Exit Function
If Not IsHexDigit(H) Then Exit Function
Select Case H
Case "0" : HexDigitVal = 0
Case "1" : HexDigitVal = 1
Case "2" : HexDigitVal = 2
Case "3" : HexDigitVal = 3
Case "4" : HexDigitVal = 4
Case "5" : HexDigitVal = 5
Case "6" : HexDigitVal = 6
Case "7" : HexDigitVal = 7
Case "8" : HexDigitVal = 8
Case "9" : HexDigitVal = 9
Case "A" : HexDigitVal = 10
Case "B" : HexDigitVal = 11
Case "C" : HexDigitVal = 12
Case "D" : HexDigitVal = 13
Case "E" : HexDigitVal = 14
Case "F" : HexDigitVal = 15
End Select

End Function

Public Function HexChar2Char(ByVal H As String) As String
HexChar2Char = ""
Dim S As String
Dim L As Long
Dim Lp As Integer
If Not IsHexDigit(H) Then Exit Function
If Len(H) <> 4 Then Exit Function
L = 0
For Lp = 1 To 4
L = L * &H10
L = L + HexDigitVal(Mid(H, Lp, 1))
Next
HexChar2Char = ChrW(L)
End Function

Public Function Phone_UCS2Str(ByVal S As String) As String
'strip off 80 & ffff
Phone_UCS2Str = ""
If Not Phone_IsUCS(S) Then Exit Function
Dim St As String
St = Left(S, Len(S) - 4) 'strip ffff
St = Right(St, Len(St) - 2) 'strp 80
Dim L As Integer
Dim Done As Boolean
Dim Str As String
Done = False
L = 0
Str = ""
While Not Done
Str = Str & HexChar2Char(Mid(St, 1 + L, 4))
L = L + 4
If L > Len(St) Then Done = True
End While
Phone_UCS2Str = Str
End Function


'PDU Functions....
Public Function Make7Bit2Octet(ByVal Str As String) As String
Dim L As Integer
Dim NextChar As Integer
Dim S As String
Dim Res As String
Dim cd As Integer
Dim ch1 As Integer
Dim ch2 As Integer
Dim Lp As Integer
Dim cnt As Integer
Dim AndNum As Integer
Dim OrNum As Integer
Dim OredMask As Integer

Make7Bit2Octet = ""
If Str = "" Then Exit Function
AndNum = &H7F
OrNum = &H1
OredMask = 0
Res = ""
cnt = 1

For L = 1 To Len(Str)

If L = Len(Str) Then NextChar = 0 Else NextChar = AscW(Mid(Str, L + 1, 1))
S = Mid(Str, L, 1)


ch1 = (AndNum And AscW(S)) 'used asc earlier
For Lp = 1 To cnt - 1
ch1 = ch1 \ 2
Next
OredMask = OredMask Or OrNum
ch2 = OredMask And NextChar
For Lp = 1 To (8 - cnt)
ch2 = ch2 * 2
Next

cd = ch2 Or ch1
Res = Res & HexChar(cd) 'hexchar should convert number to hex

'AndNum = AndNum \ 2 ' integer divide instead of /
OrNum = OrNum * 2
cnt = cnt + 1
If cnt = 8 Then
'AndNum = &H7F
OrNum = &H1
OredMask = 0
cnt = 1
L = L + 1
End If
Next
Make7Bit2Octet = Res
End Function

Public Function GetSemiOctet(ByVal Str As String) As String
'assumes input is digits string only
Dim S As String
Dim L As Integer
Dim Res As String

GetSemiOctet = ""
If Str = "" Then Exit Function

S = Str
Res = ""
If (Len(Str) Mod 2) <> 0 Then S = S & "F"
For L = 1 To Len(S) Step 2
Res = Res & Mid(S, L + 1, 1) & Mid(S, L, 1)
Next
GetSemiOctet = Res
End Function

Public Function MakeOctetTo7Bit(ByVal Str As String) As String
Dim Res As String
Dim S As String
Dim PrevChar As Integer
Dim CurChar As Integer
Dim L As Integer
Dim ch1 As Integer
Dim ch2 As Integer
Dim AndNum As Integer
Dim cnt As Integer
Dim Lp As Integer


MakeOctetTo7Bit = ""
If (Str = "") Or (Len(Str) Mod 2 <> 0) Then Exit Function
S = ""
For L = 1 To Len(Str) Step 2
'make char string s of characters
S = S & ChrW(HexDigitVal(Mid(Str, L, 1)) * &H10 + HexDigitVal(Mid(Str, L + 1, 1)))
'previously used chr
Next

Res = ""
AndNum = &H7F
PrevChar = 0
cnt = 1
For L = 1 To Len(S)
ch1 = AscW(Mid(S, L, 1)) And AndNum
For Lp = 1 To cnt - 1
ch1 = ch1 * 2
Next
'Ormask = Ormask Or OrNum
If L = 1 Then PrevChar = 0 Else PrevChar = AscW(Mid(S, L - 1, 1))
If cnt = 1 Then
ch2 = 0
Else
ch2 = PrevChar And ((Not (AndNum)) * 2)
For Lp = 1 To (9 - cnt)
ch2 = ch2 \ 2
Next
End If
Res = Res & Chr(ch1 Or ch2)
AndNum = AndNum \ 2
cnt = cnt + 1
If AndNum = 0 Then
AndNum = &H7F
cnt = 1
Res = Res & ChrW(AscW(Mid(S, L, 1)) \ 2)
'previously used chr and asc
End If
'PrevChar = Asc(Mid(S, L, 1))
Next
MakeOctetTo7Bit = Res
End Function

Public Function MakeSubmitPDU(ByVal PhoneNo As String, ByVal MessageStr As String) As String
MakeSubmitPDU = ""
On Error GoTo er
If (Len(PhoneNo) < 3) Or (Len(PhoneNo) > 20) Or (MessageStr = "") Then Exit Function
' should check for phone number to be valid digits is assumed
Dim SMSC_Info_Len As String
SMSC_Info_Len = "00"

Dim FirstOctet As String
FirstOctet = "11"

Dim TP_MessageRef As String
TP_MessageRef = "00"

Dim NumberLen As String
NumberLen = HexChar(Len(PhoneNo))

Dim NumberType As String
Dim SemiOctetNumber As String
NumberType = "81" 'local number81
SemiOctetNumber = GetSemiOctet(PhoneNo)
If Left(PhoneNo, 1) = "+" Then
NumberType = "91" 'international number
SemiOctetNumber = GetSemiOctet(Right(PhoneNo, Len(PhoneNo) - 1))
NumberLen = HexChar(Len(PhoneNo) - 1)
ElseIf Left(PhoneNo, 2) = "00" Then
NumberType = "91"
SemiOctetNumber = GetSemiOctet(Right(PhoneNo, Len(PhoneNo) - 2))
NumberLen = HexChar(Len(PhoneNo) - 2)
End If

Dim Protocol_id As String
Protocol_id = "00"

Dim DCS As String 'data coding scheme
DCS = ""
If Is7Bit(MessageStr) Then DCS = "00" '7 bit
If DCS = "" And IsUTF8(MessageStr) Then DCS = "04" '8 bit
If DCS = "" Then DCS = "08" '16 bit

Dim Validity As String
Validity = "AA" '4 days

Dim UDS As String 'user data size
If DCS <> "08" Then
UDS = HexChar(Len(MessageStr))
Else
UDS = HexChar(Len(MessageStr) * 2)
End If

Dim L As Integer
Dim UserData As String
UserData = ""
Select Case DCS
Case "00"
If Len(MessageStr) > 160 Then Exit Function
UserData = Make7Bit2Octet(MessageStr)
Case "04"
If Len(MessageStr) > 140 Then Exit Function
For L = 1 To Len(MessageStr)
UserData = UserData & HexChar(Asc(Mid(MessageStr, L, 1)))
Next
Case "08"
If Len(MessageStr) > 70 Then Exit Function
For L = 1 To Len(MessageStr)
UserData = UserData & Char2Hex(Mid(MessageStr, L, 1))
Next
End Select

MakeSubmitPDU = SMSC_Info_Len & FirstOctet & TP_MessageRef & _
NumberLen & NumberType & SemiOctetNumber & _
Protocol_id & DCS & Validity & _
UDS & UserData
Exit Function
er:
MakeSubmitPDU = ""
End Function

Public Function HexByteVal(ByVal HC As String) As Long
' was integer return type but causes overflow when convertion in charw long type
HexByteVal = 0
If Len(HC) <> 2 Then Exit Function
HexByteVal = HexDigitVal(Left(HC, 1)) * &H10 + HexDigitVal(Right(HC, 1))
End Function

Public Function GetHexByte(ByVal Str As String, ByVal Pos As Integer) As String
GetHexByte = ""
If Pos < 1 Or Pos >= Len(Str) Then Exit Function
GetHexByte = Mid(Str, Pos, 2)

End Function

Public Function DecodeDeliverPDU(ByVal PDU As String, ByVal HasSMSC As Boolean, ByRef Sender As String, ByRef dtTimeStamp As String) As String
Sender = ""
DecodeDeliverPDU = ""
dtTimeStamp = ""
On Error GoTo er
If PDU = "" Then Exit Function
If Not (IsHexDigit(PDU)) Then Exit Function
Dim Cur As Integer
Dim v As Integer
Dim S As String
Dim PDUlen As Integer

PDUlen = Len(PDU)

Cur = 1

If HasSMSC Then
S = GetHexByte(PDU, Cur)
v = HexByteVal(S)
Cur = Cur + 2 + v * 2 ' ignore smsc info
End If

Cur = Cur + 2 'ignore first octet

If Cur > PDUlen Then Exit Function

Dim NumLen As Integer

S = GetHexByte(PDU, Cur)
NumLen = HexByteVal(S)
Cur = Cur + 2 ' skip numlen to go to num type

If Cur > PDUlen Then Exit Function

S = GetHexByte(PDU, Cur)
If S = "91" Then Sender = "+"
Cur = Cur + 2 'skip num type to go to number

If Cur > PDUlen Then Exit Function

v = NumLen
If ((NumLen Mod 2) <> 0) Then v = NumLen + 1
S = GetSemiOctet(Mid(PDU, Cur, v))
Sender = Sender & Left(S, NumLen)
If UCase(Right(Sender, 1)) = "F" Then Sender = Left(Sender, Len(Sender) - 1)
Cur = Cur + v 'skip number

Cur = Cur + 2 'skip protocol id

If Cur > PDUlen Then Exit Function

Dim DCS As String
DCS = GetHexByte(PDU, Cur)
Cur = Cur + 2 'skip dcs

Cur = Cur + 14 'skip semi-octet time stamp

If Cur > PDUlen Then Exit Function
dtTimeStamp = GetSemiOctet(Mid(PDU, Cur - 14, 14))

Dim UDL As Integer 'user data length
S = GetHexByte(PDU, Cur)
UDL = HexByteVal(S)
Cur = Cur + 2 'skip udl & goto data

If Cur > PDUlen Then Exit Function

Dim L As Integer
Dim Lp As Integer
Dim UserData As String
Dim UserStr As String

UserData = ""
UserData = Right(PDU, Len(PDU) - Cur + 1)
UserStr = ""
'If DCS <> "04" And DCS <> "08" Then
If DCS = "00" Then
'coding scheme 7bit
UserStr = MakeOctetTo7Bit(UserData)

ElseIf DCS = "04" Then
'8 bit
For Lp = 1 To Len(UserData) Step 2
S = GetHexByte(UserData, Lp)
UserStr = UserStr & Chr(HexByteVal(S))
Next

ElseIf DCS = "08" Then
'16 bit
Dim s1 As String
Dim s2 As String
For Lp = 1 To Len(UserData) Step 4
s1 = GetHexByte(UserData, Lp)
s2 = GetHexByte(UserData, Lp + 2)
UserStr = UserStr & ChrW(HexByteVal(s1) * &H100 + HexByteVal(s2))
Next
End If

DecodeDeliverPDU = UserStr
Exit Function
er:
DecodeDeliverPDU = ""
End Function

Public Function SubmitPDU2Str(ByVal PDU As String, ByRef Receiver As String) As String
'i'm not sure this will work as i'm not properly checking first octet for validity byte presence

Receiver = ""
SubmitPDU2Str = ""
On Error GoTo er
If PDU = "" Then Exit Function
If Not (IsHexDigit(PDU)) Then Exit Function
Dim Cur As Integer
Dim v As Integer
Dim S As String
Dim PDUlen As Integer

PDUlen = Len(PDU)

Cur = 1


S = GetHexByte(PDU, Cur)
v = HexByteVal(S)
Cur = Cur + 2 + v * 2 ' ignore smsc info

If Cur > PDUlen Then Exit Function

'if first octet=01 then no validity period
Dim FirstOctet As Integer
S = GetHexByte(PDU, Cur)
FirstOctet = HexByteVal(S)
Cur = Cur + 2 'skip first octet

Cur = Cur + 2 'skip tp message ref

If Cur > PDUlen Then Exit Function

Dim NumLen As Integer

S = GetHexByte(PDU, Cur)
NumLen = HexByteVal(S)
Cur = Cur + 2 ' skip numlen to go to num type

If Cur > PDUlen Then Exit Function

S = GetHexByte(PDU, Cur)
If S = "91" Then Receiver = "+"
Cur = Cur + 2 'skip num type to go to number

If Cur > PDUlen Then Exit Function

v = NumLen
If ((NumLen Mod 2) <> 0) Then v = NumLen + 1
S = GetSemiOctet(Mid(PDU, Cur, v))
Receiver = Receiver & Left(S, NumLen)
If UCase(Right(Receiver, 1)) = "F" Then Receiver = Left(Receiver, Len(Receiver) - 1)
Cur = Cur + v 'skip number

Cur = Cur + 2 'skip protocol id

If Cur > PDUlen Then Exit Function

Dim DCS As String
DCS = GetHexByte(PDU, Cur)
Cur = Cur + 2 'skip dcs

If (FirstOctet And &H18) = &H10 Then
Cur = Cur + 2 'skip validity
ElseIf (FirstOctet And &H18) <> 0 Then
Cur = Cur + 14 '7 octet validity
End If

If Cur > PDUlen Then Exit Function

Dim UDL As Integer 'user data length
S = GetHexByte(PDU, Cur)
UDL = HexByteVal(S)
Cur = Cur + 2 'skip udl & goto data

If Cur > PDUlen Then Exit Function

Dim L As Integer
Dim Lp As Integer
Dim UserData As String
Dim UserStr As String

UserData = ""
UserData = Right(PDU, Len(PDU) - Cur + 1)
UserStr = ""
'If DCS <> "04" And DCS <> "08" Then
If DCS = "00" Then
'coding scheme 7bit
UserStr = MakeOctetTo7Bit(UserData)

ElseIf DCS = "04" Then
'8 bit
For Lp = 1 To Len(UserData) Step 2
S = GetHexByte(UserData, Lp)
UserStr = UserStr & Chr(HexByteVal(S))
Next

ElseIf DCS = "08" Then
'16 bit
Dim s1 As String
Dim s2 As String
For Lp = 1 To Len(UserData) Step 4
s1 = GetHexByte(UserData, Lp)
s2 = GetHexByte(UserData, Lp + 2)
UserStr = UserStr & ChrW(HexByteVal(s1) * &H100 + HexByteVal(s2))
Next
End If

SubmitPDU2Str = UserStr
Exit Function
er:
SubmitPDU2Str = ""
End Function

End Class
باید این نکته را متذکر شوم که فقط باید از تابع MakeSubmitPDU استفاده کنید

[ahp_online]

با سلام
در مورد نحوه کار این کد نمیشه توضیح بدید؟؟آخه چیزی ازش نفهمیدم؟میشه بگید چطوری یک اس ام اس فارسی با فرمت پی دی یو ارسال میشه؟؟چطور باید تو برنامه توابع رو فراخوانی کرد(منظورم ترتیبشه)؟