home *** CD-ROM | disk | FTP | other *** search
/ PC Pro 1999 January / dppcpro0199a.iso / January / Fp98 / SDK / cgi / olecgivb / util.bas < prev   
Encoding:
BASIC Source File  |  1997-09-18  |  4.5 KB  |  167 lines
  1. Attribute VB_Name = "modUtil"
  2. Option Explicit
  3.  
  4. Private Type RECT
  5.     Left As Long
  6.     Top As Long
  7.     Right As Long
  8.     Bottom As Long
  9. End Type
  10.  
  11. Private Declare Function GetWindowRect Lib "user32" (ByVal hwnd As Long, lpRect As RECT) As Long
  12. Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
  13.  
  14. Private Const HWND_NOTOPMOST = -2
  15. Private Const HWND_TOPMOST = -1
  16. Private Const SWP_NOMOVE = &H2
  17. Private Const SWP_NOSIZE = &H1
  18.  
  19. Public Function UrlEncodeString(ByVal str As String) As String
  20.  
  21.     Dim pos As Long    ' current loc in src
  22.     Dim last As Long   ' last loc in string
  23.     Dim ch As String   ' current char
  24.     Dim cc As Integer  ' char code
  25.     Dim hstr As String ' hex string
  26.     Dim out As String  ' output string
  27.     
  28.     Dim cSpace As Integer   ' code for space
  29.     Dim cSquig As Integer   ' code for squiggle
  30.     Dim cAmp As Integer     ' code for amp
  31.     Dim cPlus As Integer    ' code for plus
  32.     Dim cPct As Integer     ' code for percent
  33.     Dim cEq As Integer      ' code for equals
  34.     
  35.     cSpace = Asc(" ")
  36.     cSquig = Asc("~")
  37.     cAmp = Asc("&")
  38.     cPlus = Asc("+")
  39.     cPct = Asc("%")
  40.     cEq = Asc("=")
  41.     
  42.     last = Len(str)
  43.     pos = 1
  44.     
  45.     While pos <= last
  46.         ch = Mid$(str, pos, 1)
  47.         cc = Asc(ch)
  48.         If cc = cSpace Then
  49.             out = out & "+"
  50.         ElseIf (cc > cSpace And cc <= cSquig _
  51.             And cc <> cAmp And cc <> cPlus _
  52.             And cc <> cPct And cc <> cEq) Then
  53.             out = out & ch
  54.         Else
  55.             ' convert to hex
  56.             hstr = Hex$(cc)
  57.             hstr = Right$(hstr, 2)  ' make sure it's only one byte
  58.             If Len(hstr) = 0 Then
  59.                 hstr = "00"
  60.             ElseIf Len(hstr) = 1 Then
  61.                 hstr = "0" & hstr
  62.             End If
  63.             out = out & "%" & hstr
  64.         End If
  65.         pos = pos + 1
  66.     Wend
  67.     
  68.     UrlEncodeString = out
  69.  
  70. End Function
  71.  
  72.  
  73.  
  74. Public Function UrlDecodeString(ByVal inp As String) As String
  75.         
  76.     Dim out As String
  77.     
  78.     ' change all pluses (+) to spaces ( ),
  79.     ' and change all hex strings (%xx) to actual chars
  80.  
  81.     Dim ch As String      ' current char
  82.     Dim cc As Integer     ' current char code
  83.     Dim pos As Integer    ' current position in string
  84.     Dim tail As Integer   ' last position in string
  85.     Dim hexstr As String  ' extracted hex Value
  86.     
  87.     Dim plusCode As Integer
  88.     Dim pctCode As Integer
  89.     
  90.     plusCode = Asc("+")
  91.     pctCode = Asc("%")
  92.     
  93.     pos = 1
  94.     tail = Len(inp)
  95.     
  96.     While pos <= tail
  97.     
  98.         ch = Mid$(inp, pos, 1)
  99.         cc = Asc(ch)
  100.         
  101.         If cc = plusCode Then
  102.             out = out & " "
  103.             pos = pos + 1
  104.         ElseIf cc = pctCode Then
  105.             hexstr = "&H" & Mid$(inp, pos + 1, 2)
  106.             out = out & Chr$(Val(hexstr))
  107.             pos = pos + 3
  108.         Else
  109.             ' regular char
  110.             out = out & ch
  111.             pos = pos + 1
  112.         End If
  113.                     
  114.     Wend
  115.     
  116.     UrlDecodeString = out
  117.  
  118. End Function
  119.  
  120.  
  121.  
  122.  
  123. Public Sub CenterForm(frm As Form, wnd As Long)
  124.  
  125.     Dim sx As Long
  126.     Dim sy As Long
  127.     
  128.     If wnd <> 0 Then
  129.         ' center over parent window
  130.         Dim scrnRect As RECT
  131.         Dim retval As Long
  132.         retval = GetWindowRect(wnd, scrnRect)
  133.         sx = scrnRect.Left + ((scrnRect.Right - scrnRect.Left) / 2)
  134.         sx = sx * Screen.TwipsPerPixelX
  135.         sx = sx - (frm.Width / 2)
  136.         sy = scrnRect.Top + ((scrnRect.Bottom - scrnRect.Top) / 2)
  137.         sy = sy * Screen.TwipsPerPixelY
  138.         sy = sy - (frm.Height / 2)
  139.     Else
  140.         ' center on root
  141.         sx = (Screen.Width / 2) - (frm.Width / 2)
  142.         sy = (Screen.Height / 2) - (frm.Height / 2)
  143.     End If
  144.     
  145.     ' make sure the entire form is on the screen
  146.     If sx + frm.Width > Screen.Width Then sx = Screen.Width - frm.Width
  147.     If sx < 0 Then sx = 0
  148.     If sy + frm.Height > Screen.Height Then sy = Screen.Height - frm.Height
  149.     If sy < 0 Then sy = 0
  150.     
  151.     ' move it
  152.     frm.Move sx, sy
  153.  
  154. End Sub
  155.  
  156. Public Sub FloatForm(f As Form, yesno As Integer)
  157.  
  158.     Dim ret As Long
  159.  
  160.     If yesno Then
  161.         ret = SetWindowPos(f.hwnd, HWND_TOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
  162.     Else
  163.         ret = SetWindowPos(f.hwnd, HWND_NOTOPMOST, 0, 0, 0, 0, SWP_NOMOVE Or SWP_NOSIZE)
  164.     End If
  165.     
  166. End Sub
  167.