home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 4_2005-2006.ISO / data / Zips / GPRS_WAP_S196203132006.psc / Convensions.bas < prev    next >
BASIC Source File  |  2005-12-31  |  6KB  |  173 lines
  1. Attribute VB_Name = "Convensions"
  2. Public Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
  3. Public Const SW_SHOWNORMAL = 1
  4.  
  5. Private Declare Function GetTimeZoneInformation Lib "kernel32" _
  6.                           (lpTimeZoneInformation As TIME_ZONE_INFORMATION) As Long
  7. Private Type SYSTEMTIME
  8.     wYear                       As Integer
  9.     wMonth                      As Integer
  10.     wDayOfWeek                  As Integer
  11.     wDay                        As Integer
  12.     wHour                       As Integer
  13.     wMinute                     As Integer
  14.     wSecond                     As Integer
  15.     wMilliseconds               As Integer
  16. End Type
  17.  
  18. Private Type TIME_ZONE_INFORMATION
  19.     Bias                        As Long
  20.     StandardName(63)            As Byte
  21.     StandardDate                As SYSTEMTIME
  22.     StandardBias                As Long
  23.     DaylightName(63)            As Byte
  24.     DaylightDate                As SYSTEMTIME
  25.     DaylightBias                As Long
  26. End Type
  27. Public Function ContentType(Extens As String) As String
  28. 'References
  29. 'http://www.iana.org/assignments/media-types/
  30. 'http://www.wapforum.org/wina/wsp-content-type.htm
  31. 'http://www.utoronto.ca/webdocs/HTMLdocs/Book/Book-3ed/appb/mimetype.html
  32. 'http://www.utoronto.ca/ian/books/xhtml1/mime/mimetype.html#audi
  33. 'HKEY_CLASSES_ROOT\MIME\Database\Content Type
  34.   Select Case LCase(Extens)
  35.     Case "jad": ContentType = "text/vnd.sun.j2me.app-descriptor"
  36.     Case "jar": ContentType = "application/java-archive"
  37.     Case "wml", "xml": ContentType = "text/vnd.wap.wml"
  38.     Case "mid": ContentType = "audio/midi"
  39.     Case "jpg": ContentType = "image/jpeg"
  40.     Case "gif": ContentType = "image/gif"
  41.     Case "wmlc": ContentType = "application/vnd.wap.wmlc"
  42.     Case "wbxml": ContentType = "application/vnd.wap.wbxml"
  43.     Case "wmlsc": ContentType = "application/vnd.wap.wmlscriptc"
  44.     Case "sic": ContentType = "application/vnd.wap.sic"
  45.     Case "mmf": ContentType = "application/vnd.smaf" 'audio
  46.     Case "wmls": ContentType = "text/vnd.wap.wmlscript"
  47.     Case "wbmp": ContentType = "image/vnd.wap.wbmp"
  48.     Case "wav": ContentType = "audio/x-wav"
  49.     Case "mmid": ContentType = "x-music/x-midi"
  50.     Case "amr": ContentType = "audio/amr"
  51.     Case "ico": ContentType = "image/x-icon"
  52.   Case Else
  53.       Dim RegVal$
  54.       RegVal$ = GetKeyValue(HKEY_CLASSES_ROOT, "." & LCase(Extens), "Content Type")
  55.       If RegVal = "" Then ErrorLog "Unknown Content type: ." & Extens
  56.       ContentType = RegVal
  57.   End Select
  58. End Function
  59.  
  60. Public Function dIcon(Extens As String) As Integer
  61.   Select Case LCase(Extens)
  62.     Case "wml", "xml", "wmlc", "wbxml", "wmlsc", "sic", "wmls", "wbmp": dIcon = 0
  63.     Case "mid", "mmid", "mmf": dIcon = 1
  64.     Case "wav", "amr", "mp3": dIcon = 2
  65.     Case "jpg", "gif", "bmp", "ico": dIcon = 3
  66.     Case "jad", "jar": dIcon = 4
  67.   End Select
  68. End Function
  69. Public Sub ErrorLog(ErrDesc As String)
  70.   Debug.Print ErrDesc
  71.   Open App.Path & "\Logs\ErrorLog.txt" For Append As #1
  72.      Print #1, ErrDesc
  73.   Close #1
  74. End Sub
  75.  
  76. Public Function ddd(ByVal day As Integer) As String
  77.   'because format(date,"ddd") may return day in computer native language
  78.   Select Case day
  79.     Case 1: ddd = "Sun"
  80.     Case 2: ddd = "Mon"
  81.     Case 3: ddd = "Tue"
  82.     Case 4: ddd = "Wed"
  83.     Case 5: ddd = "Thu"
  84.     Case 6: ddd = "Fri"
  85.     Case 7: ddd = "Sat"
  86.   End Select
  87. End Function
  88.  
  89. Public Function mmm(ByVal month As Integer) As String
  90.   'because format(date,"mmm") may return day in computer native language
  91.   Select Case month
  92.     Case 1: mmm = "Jan"
  93.     Case 2: mmm = "Feb"
  94.     Case 3: mmm = "Mar"
  95.     Case 4: mmm = "Apr"
  96.     Case 5: mmm = "May"
  97.     Case 6: mmm = "Jun"
  98.     Case 7: mmm = "Jul"
  99.     Case 8: mmm = "Aug"
  100.     Case 9: mmm = "Sep"
  101.     Case 10: mmm = "Oct"
  102.     Case 11: mmm = "Nov"
  103.     Case 12: mmm = "Dec"
  104.   End Select
  105. End Function
  106.  
  107. Function GetGMTDateTime() As String
  108.     'Wild function to get the GMT Date/Time
  109.     Dim utTZ As TIME_ZONE_INFORMATION
  110.     Dim h&, m&, hh&, mm&, dy&, mo&, yy&
  111.     Select Case GetTimeZoneInformation(utTZ)
  112.       Case TIME_ZONE_ID_DAYLIGHT
  113.         dwBias = utTZ.Bias + utTZ.DaylightBias
  114.       Case Else
  115.         dwBias = utTZ.Bias + utTZ.StandardBias
  116.     End Select
  117.     h = dwBias \ 60
  118.     m = dwBias - (dwBias \ 60) * 60
  119.     hh = Hour(Time) + h
  120.     mm = Minute(Time) + m
  121.     dy = day(Date)
  122.     mo = month(Date)
  123.     yy = Year(Date)
  124.     If mm < 0 Then
  125.        mm = mm + 60
  126.        hh = hh - 1
  127.     End If
  128.     If mm > 60 Then
  129.        mm = mm - 60
  130.        hh = hh + 1
  131.     End If
  132.     If hh < 0 Then
  133.        hh = hh + 24
  134.        dy = dy - 1
  135.     End If
  136.     If hh > 24 Then
  137.        hh = hh - 24
  138.        dy = dy + 1
  139.     End If
  140.     If dy <= 0 Then
  141.        mo = mo - 1
  142.        dy = MonthDays(mo, yy)
  143.     End If
  144.     If dy > MonthDays(mo, yy) Then
  145.        mo = mo + 1
  146.        dy = 1
  147.     End If
  148.     If mo < 0 Then
  149.        mo = mo + 12
  150.        yy = yy - 1
  151.     End If
  152.     If mo > 12 Then
  153.        mo = mo - 12
  154.        yy = yy + 1
  155.     End If
  156.     
  157.     GetGMTDateTime = ddd(Weekday(DateSerial(yy, mo, dy))) & ", " & Format(dy, "00") & " " & mmm(mo) & " " & yy & " " & Format(hh, "00") & ":" & Format(mm, "00") & ":" & Format(Second(Time), "00") & " GMT"
  158. End Function
  159.  
  160. Function MonthDays(ByVal month As Integer, ByVal inYear As Integer) As Integer
  161. 'Todo add leapyear support
  162. Select Case month
  163.   Case 1, 3, 5, 7, 8, 10, 12: MonthDays = 31
  164.   Case 4, 6, 9, 11: MonthDays = 30
  165.   Case 2:
  166.     If ((inYear Mod 4 = 0) And (inYear Mod 100 <> 0) Or (inYear Mod 400 = 0)) Then
  167.       MonthDays = 29
  168.     Else
  169.       MonthDays = 28
  170.     End If
  171. End Select
  172. End Function
  173.