Save SMS as .VMG File for Nokia Phones

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: ASP