skip to main | skip to sidebar

VMG Files are Plain text format used for storing SMS text messages on Nokia cell phones; contains header information such as the sender, date, and time, as well as the actual message encoded as UTF-16LE..

at some Application i needed a way to Export SMS Messages to be able to Copy it to my Nokia phone, of Course to drafts folders.. since you can't copy it directly to outbox..

well, here is a function to save an sms to a .VMG file using ADODB.Stream
''''' Save SMS as VMG file
Sub SaveSMS(FilePath,Receipents,SMS,SMSTime)
  Const adTypeText = 2
  Const adSaveCreateOverWrite = 2

  Dim stream : Set stream = Server.CreateObject("ADODB.stream")
  stream.Type = adTypeText
  stream.Charset = "UTF-16LE"
  Stream.Open

  stream.WriteText "BEGIN:VMSG" & vbCrLf & _
           "VERSION:1.1" & vbCrLf & _
           "X-IRMC-STATUS:DRAFT" & vbCrLf & _
           "X-IRMC-BOX:INBOX" & vbCrLf & _
           "BEGIN:VCARD" & vbCrLf & _
           "VERSION:2.1" & vbCrLf & _
           "N:" & vbCrLf & _
           "TEL:" & vbCrLf & _
           "END:VCARD" & vbCrLf
            
  Dim i
  For i = 0 To UBound(Receipents)
    stream.WriteText "BEGIN:VENV" & vbCrLf & _
            "BEGIN:VCARD" & vbCrLf & _
            "VERSION:2.1" & vbCrLf & _
            "N:"& Receipents(i)(0) & vbCrLf & _
            "TEL:" & Receipents(i)(1) & vbCrLf & _
            "END:VCARD" & vbCrLf
  Next

  stream.WriteText "BEGIN:VENV" & vbCrLf & _
          "BEGIN:VBODY" & vbCrLf & _
          "Date:" & VMGTime(SMSTime) & vbCrLf & _
          SMS & vbCrLf & _
          "END:VBODY" & vbCrLf & _
          "END:VENV" & vbCrLf

  For i = 0 To UBound(Receipents)
    stream.WriteText "END:VENV" & VbCrLf
  Next

  stream.WriteText "END:VMSG" & vbCrLf
  stream.Flush

  stream.SaveToFile FilePath, adSaveCreateOverWrite
  stream.Close
  Set stream = Nothing
End Sub

Function VMGTime(d)
  VMGTime = pad2(Day(d)) & "." & pad2(Month(d)) & "." & Year(d) & " " & Hour(d) & ":" & Minute(d) & ":" & Second(d)
End Function

Private Function pad2(str)
  If Len(str)<2Then
    pad2 = "0" & str
  Else
    pad2 = str
  End If
End Function

'' A sample Call
Call SaveSMS(Server.MapPath("1.vmg"),array(Array("John","22222222"),Array("Paul","11111111")),"Hello SMS",now)

Tags:

0 comments

Post a Comment

Thank you for taking the time to comment..
* If you have a tech issue with one of my plugins, you may email me on mike[at]moretechtips.net

Mike

Mike MoreWeb developer, jQuery plugin author, social media fan and Technology Blogger.
My favorite topics are: jQuery , Javascript , ASP.Net , Twitter , Google..
<connect with="me"> </connect>

Subscribe by email

Enter your email address:

or via RSS