cgi4rtn.bas

加入一个用VB编写CGI的VB源程序。（你需要在Win98上首先安装20Personal WebServer

   pad = Left$(CStr(vPad), 1)
End If

lSize = pos - lSource
If lSize > 0 Then               'pad character will be used
   pad = String(lSize, pad)     'string of pad characters
Else
   pad = ""
End If

sSource = Left$(sSource, pos) & pad & sTarget _
         & Mid$(sSource, pos + 1)

exitInsertA:
InsertA = sSource
End Function

Public Function Overlay(ByVal sSource As String, _
                              sTarget As String, _
                        Optional vPos As Variant, _
                        Optional vPad As Variant) As String
'=========================================================
' Overlay - overlays sSource with sTarget at position vPos
' If vPos is greater than the length of sSource then
'    sSource will be padded with spaces or with vPad
' Usage:
'    Overlay("12345", "=")            "=2345"
'    Overlay("12345", "=", 3)         "12=45"
'    Overlay("12345", "=", 8)         "12345  ="
'    Overlay("12345", "=", 8, ".")    "12345..="
'=========================================================
Dim lSource     As Long   'length of sSource
Dim lSize       As Long   'minimum size needed for Overlay
Dim lTarget     As Long   'length of sTarget
Dim pos         As Long   'vPos converted to long
Dim pad         As String 'vPad converted to string

If sTarget = "" Then GoTo exitOverlay 'sTarget cannot be empty
lTarget = Len(sTarget)
lSource = Len(sSource)

'validate pos

If IsMissing(vPos) Then          'default = 1
   pos = 1
ElseIf Not IsNumeric(vPos) Then
   pos = 1
ElseIf vPos = 0 Then             'pos cannot be 0
   pos = 1
ElseIf Abs(vPos) > 1024000 Then  'be reasonable
   pos = 1
Else                             'no negative numbers
   pos = Abs(CLng(vPos))
End If

'validate pad

If IsMissing(vPad) Then          'default = " "
   pad = " "
ElseIf vPad = "" Then
   pad = " "
Else
   pad = Left$(CStr(vPad), 1)    'only the first character of pad
End If

lSize = pos + lTarget - 1        'expand sSource if necessary
If lSize > lSource Then          'pad character will be used
   sSource = sSource & String(lSize - lSource, pad)
End If
Mid$(sSource, pos, lTarget) = sTarget

exitOverlay:
Overlay = sSource
End Function

Public Function DelStr(sSource As String, _
                        lStart As Long, _
             Optional vLength As Variant) As String
'================================================================
' DelStr returns characters from sSource after deleting
' vLength characters starting at lStart. If vLength is not entered,
' DelStr deletes characters from lStart to the end of sSource.
' DelStr is the opposite of Mid$().
' Usage:
'    DelStr("abcdef",2)             "a"
'    DelStr("abcdef",2,2)           "adef"
'=====================================================
Dim lSource As Long   'length of sSource
Dim lLength As Long   'vLength converted to long

DelStr = sSource
lSource = Len(sSource)
If lStart <= 0 _
Or lStart > lSource _
Or lSource = 0 Then Exit Function
   
If IsMissing(vLength) Then
   DelStr = Left$(sSource, lStart - 1)
   Exit Function
ElseIf Not IsNumeric(vLength) Then
   Exit Function
End If
lLength = CLng(vLength)
If lLength < 1 Then Exit Function
DelStr = Left$(sSource, lStart - 1) _
        & Mid$(sSource, lStart + lLength)
End Function

Public Function ParseCount(sSource As String, sTarget As String) As Long
'=================================================
' ParseCount returns the number of elements
' in sSource that are delimited by sTarget
'   Usage:
'     ParseCount("red;blue;green", ";")   3
'     ParseCount("how many words", " ")   3
'=================================================
Dim pointer As Long    'pointer in sSource
Dim pos     As Long    'position of sTarget
Dim lTarget As Long    'length of sTarget
Dim lSource As Long    'length of sSource

If sSource = "" Then Exit Function     'nothing to count
If sTarget = "" Then sTarget = " "     'sTarget cannot be empty

lTarget = Len(sTarget)
lSource = Len(sSource)
pointer = 1

Do
   pos = InStr(pointer, sSource, sTarget)
   If pos = 0 Then pos = lSource + 1   'last Target
   ParseCount = ParseCount + 1         'increment
   pointer = pos + lTarget
Loop Until pos > lSource
End Function

Public Function ParseItem(ByVal sSource As String, _
                          ByVal sTarget As String, _
                                      n As Long) As String
'=================================================
' ParseItem returns the nth element in sSource
' delimited by sTarget. Negative values of n will
' return the nth item from the end.
' Usage:
'    ParseItem("123+45", "+", 1)         "123"
'    ParseItem("123+45", "+", 2)         "45"
'    ParseItem("12345",  "+", 1)         "12345"
'    ParseItem("12345",  "+", 2)         ""
'    ParseItem("127.0.0.1", ".", -1)     "1"
'=================================================
Dim backward As Boolean   'direction of search
Dim pointer  As Long      'pointer in sSource
Dim pos      As Long      'position of sTarget
Dim x        As Long      'counter
Dim lTarget  As Long      'length of sTarget
Dim lSource  As Long      'length of sSource

If n = 0 Then Exit Function
If sSource = "" Then Exit Function
If sTarget = "" Then sTarget = " "     'sTarget cannot be empty

lTarget = Len(sTarget)
lSource = Len(sSource)
pointer = 1

If n < 0 Then                          'negative value
   backward = True                     'search from end
   n = Abs(n)
   sSource = Reverse(sSource)
   sTarget = Reverse(sTarget)
End If
   
Do
   pos = InStr(pointer, sSource, sTarget)
   If pos = 0 Then pos = lSource + 1   'last item
   x = x + 1                           'increment
   If n = x Then                       'the item being sought
      ParseItem = Mid$(sSource, pointer, pos - pointer)
      If backward Then ParseItem = Reverse(ParseItem)
      Exit Do                          'done
   End If
   pointer = pos + lTarget
Loop Until pos > lSource
End Function

Public Function ParseToArray(sSource As String, _
                             sTarget As String) As Variant
'=================================================
' ParseToArray splits a string delimited by sTarget
' into separate elements in an array.
' a(0) to a(n) will contain the parsed elements.
' If sSource is empty string, a(0) = ""
' Usage: Dim x as variant, e as string, n as long
'        x = parseToArray()
'        n = ubound(x)     'number of elements
'        e = x(0)          'reference an element
'=================================================
'
Dim a()      As String  'array containing elements
Dim pointer  As Long    'pointer in sSource
Dim pos      As Long    'position of sTarget
Dim x        As Long    'array index
Dim lTarget  As Long    'length of sTarget
Dim lSource  As Long    'length of sSource

If sTarget = "" Then sTarget = " "      'sTarget cannot be null

lTarget = Len(sTarget)
lSource = Len(sSource)
pointer = 1

Do
   pos = InStr(pointer, sSource, sTarget)
   If pos = 0 Then pos = lSource + 1            'last item
   ReDim Preserve a(x)                          'add to the array
   a(x) = Mid$(sSource, pointer, pos - pointer) 'put item in the array
   x = x + 1                                    'increment array index
   pointer = pos + lTarget                      'skip to the next item
Loop Until pos > lSource

ParseToArray = a()                  'return the array as a variant
Erase a()
End Function

Public Function Reverse(sSource As String) As String
'=====================================================
' Reverse returns a "mirror image" of the input string
' Usage:
'    Reverse("12345")             "54321"
'=====================================================
Dim x       As Long   'counter
Dim lSource As Long   'length of sSource
Dim lPlus   As Long   'lSource + 1

Reverse = sSource
lSource = Len(sSource)
If lSource < 2 Then Exit Function
lPlus = lSource + 1
For x = 1 To lSource
    Mid$(Reverse, lPlus - x, 1) = Mid$(sSource, x, 1)
Next x
End Function

Public Function UrlEncode(ByVal sSource As String) As String
'------------------------------------------------
'urlEncode
'replace unsafe and reserved characters with %xx
'replace " " with "+"
'------------------------------------------------
Dim x       As Long   'counter
Dim c       As String 'character
Dim h       As String 'hexadecimal
Dim pos     As Long   'position used with Instr()
Dim pointer As Long   'pointer in sSource

x = 1
Do Until x > Len(sSource)
   c = Mid$(sSource, x, 1)
   
   If InStr(1, "abcdefghijklmnopqrstuvwxyz0123456789.-_* ", c, 1) Then
      x = x + 1
   Else
      'replace reserved chars with "%xx"
      h = Hex$(Asc(c))
      If Len(h) = 1 Then h = "0" & h
      
      sSource = Left$(sSource, x - 1) _
        & "%" & h _
        & Mid$(sSource, x + 1)
      x = x + 3
   End If
Loop

'replace " " with "+"
pointer = 1
Do
   pos = InStr(pointer, sSource, " ")
   If pos = 0 Then Exit Do
   Mid$(sSource, pos, 1) = "+"
   pointer = pos + 1
Loop

UrlEncode = sSource
End Function

Public Function TempFile(sPath As String, sPrefix As String) As String
'------------------------------------------------------------
' TempFile returns the name of a unique temporary file name
' prefixed with sPrefix (3 chars or less) in directory sPath
' file extension will be .TMP
'------------------------------------------------------------

Dim x  As Long
Dim rc As Long

TempFile = String(127, Chr$(0))

rc = GetTempFileName(sPath, sPrefix, ByVal 0&, TempFile)
x = InStr(TempFile, Chr$(0))
If x > 0 Then TempFile = Left$(TempFile, x - 1)
End Function