cgi4rtn.bas

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

Attribute VB_Name = "CGI4RTN"
Option Explicit
'=============================================
'CGI4RTN Common routines
'Author: Kevin O'Brien <[e-mail]>
'                      <[e-mail]>
'Version: 1.5 September 1997
'=============================================

Private Declare Function GetTempFileName Lib "kernel32" _
    Alias "GetTempFileNameA" _
   (ByVal lpszPath As String, _
    ByVal lpPrefixString As String, _
    ByVal wUnique As Long, _
    ByVal lpTempFileName As String) As Long

Public Function Strip(ByVal sSource As String, _
                      ByVal sTarget As String, _
                     Optional vType As Variant) As String
'====================================================
' Strip removes occurrences of sTarget from sSource.
' Optional parameter:
'   vType
'       A = all occurrences (default)
'       B = leading and trailing occurrences
'       L = leading occurrences
'       T = trailing occurrences
'     <n> = nth occurrence
'    <-n> = nth occurrence from the end
'   Usage:
'    Strip("--123-45--", "-")         "12345"
'    Strip("--123-45--", "-", "B")    "123-45"
'    Strip("--123-45--", "-", "L")    "123-45--"
'    Strip("--123-45--", "-", "T")    "--123-45"
'    Strip("--123-45--", "-", 1)      "-123-45--"
'    Strip("--123-45--", "-", -1)     "--123-45-"
'====================================================
Dim backward As Boolean 'direction of search
Dim x        As Long    'counter
Dim pos      As Long    'position of sTarget
Dim pointer  As Long    'start of InStr
Dim lTarget  As Long    'length of sTarget
Dim lType    As Long    'vType converted to long
Dim sType    As String  'vType converted to string

If sTarget = "" Then GoTo exitStrip      ' sTarget cannot be empty
lTarget = Len(sTarget)

'validate vType

If IsMissing(vType) Then
   sType = "A"                           ' default = "A" (all)
ElseIf vType = "" Then
   sType = "A"
ElseIf IsNumeric(vType) Then             ' a number was entered
   GoTo numStrip
Else
   sType = Left$(UCase$(vType), 1)       ' Use only the first character
End If

If InStr("ABLT", sType) = 0 Then sType = "A"

Select Case sType
   Case "A" 'all
      Do
         pos = InStr(1, sSource, sTarget)
         If pos = 0 Then Exit Do
         sSource = Left$(sSource, pos - 1) & Mid$(sSource, pos + lTarget)
      Loop
   Case "B" 'leading and trailing
      Do While InStr(1, sSource, sTarget) = 1
         sSource = Mid$(sSource, lTarget + 1)
      Loop
      sSource = Reverse(sSource)
      sTarget = Reverse(sTarget)
      Do While InStr(1, sSource, sTarget) = 1
         sSource = Mid$(sSource, lTarget + 1)
      Loop
      sSource = Reverse(sSource)
   Case "L" 'leading
      Do While InStr(1, sSource, sTarget) = 1
         sSource = Mid$(sSource, lTarget + 1)
      Loop
   Case "T" 'trailing
      sSource = Reverse(sSource)
      sTarget = Reverse(sTarget)
      Do While InStr(1, sSource, sTarget) = 1
         sSource = Mid$(sSource, lTarget + 1)
      Loop
      sSource = Reverse(sSource)
End Select
GoTo exitStrip                           ' done

numStrip:
lType = CLng(vType)                      ' convert to long
If lType = 0 Then GoTo exitStrip         ' cannot be zero
x = 1
pointer = 1

If lType < 0 Then
   backward = True
   lType = Abs(lType)
   sSource = Reverse(sSource)
   sTarget = Reverse(sTarget)
End If

Do
   pos = InStr(pointer, sSource, sTarget)
   If pos = 0 Then Exit Do
   If x = lType Then
      sSource = Left$(sSource, pos - 1) _
               & Mid$(sSource, pos + lTarget)
      Exit Do
   End If
   x = x + 1
   pointer = pos + lTarget
Loop
If backward Then sSource = Reverse(sSource)

exitStrip:
Strip = sSource
End Function

Public Function Translate(ByVal sSource As String, _
                            ByVal sFrom As String, _
                              ByVal sTo As String, _
                         Optional vType As Variant) As String
'======================================================
' Translate replaces all occurences of sFrom with sTo
' within sSource
' No replacement is done if sSource or sFrom are empty.
' Optional parameter:
'   vType
'       A = all occurrences (default)
'       B = leading and trailing occurrences
'       L = leading occurences
'       T = trailing occurences
'     <n> = nth occurrence
'    <-n> = nth occurrence from the end
' Usage:
'    Translate("--12-3--", "-", ".")       "..12.3.."
'    Translate("--12-3--", "-", ".", "B")  "..12-3.."
'    Translate("--12-3--", "-", ".", "L")  "..12-3--"
'    Translate("--12-3--", "-", ".", "T")  "--12-3.."
'    Translate("--12-3--", "-", ".", 1)    ".-12-3--"
'    Translate("--12-3--", "-", ".", -1)   "--12-3-."
'======================================================
Dim backward As Boolean 'direction of search
Dim x        As Long    'counter
Dim pointer  As Long    'start of InStr
Dim pos      As Long    'position of sFrom
Dim lFrom    As Long    'length of sFrom
Dim lTo      As Long    'length of sTo
Dim lType    As Long    'vType converted to long
Dim sType    As String  'vType converted to string

If sSource = "" Or sFrom = "" Then GoTo exitTranslate
lFrom = Len(sFrom)
lTo = Len(sTo)

'validate vType

If IsMissing(vType) Then
   sType = "A"                          'default = "A" (all)
ElseIf vType = "" Then
   sType = "A"
ElseIf IsNumeric(vType) Then
   GoTo numTranslate                    'translate nth occurrence
Else
   sType = Left$(UCase$(vType), 1)      'a string was entered
End If

If InStr("ABLT", sType) = 0 Then sType = "A"

Select Case sType
 Case "A" 'all
   pointer = 1
   Do
     pos = InStr(pointer, sSource, sFrom)
     If pos = 0 Then Exit Do
     sSource = Left$(sSource, pos - 1) & sTo _
              & Mid$(sSource, pos + lFrom)
     pointer = pos + lTo
   Loop
 
 Case "B" 'leading and trailing
   pointer = 1
   Do
     pos = InStr(pointer, sSource, sFrom)
     If pos <> pointer Then Exit Do
     sSource = Left$(sSource, pos - 1) & sTo & Mid$(sSource, pos + lFrom)
     pointer = pos + lTo
   Loop
   sSource = Reverse(sSource)
   sFrom = Reverse(sFrom)
   sTo = Reverse(sTo)
   pointer = 1
   Do
     pos = InStr(pointer, sSource, sFrom)
     If pos <> pointer Then Exit Do
     sSource = Left$(sSource, pos - 1) & sTo & Mid$(sSource, pos + lFrom)
     pointer = pos + lTo
   Loop
   sSource = Reverse(sSource)
   
 Case "L" 'leading
   pointer = 1
   Do
     pos = InStr(pointer, sSource, sFrom)
     If pos <> pointer Then Exit Do
     sSource = Left$(sSource, pos - 1) & sTo & Mid$(sSource, pos + lFrom)
     pointer = pos + lTo
   Loop
   
 Case "T" 'trailing
   sSource = Reverse(sSource)
   sFrom = Reverse(sFrom)
   sTo = Reverse(sTo)
   pointer = 1
   Do
     pos = InStr(pointer, sSource, sFrom)
     If pos <> pointer Then Exit Do
     sSource = Left$(sSource, pos - 1) & sTo & Mid$(sSource, pos + lFrom)
     x = pos + lTo
   Loop
   sSource = Reverse(sSource)
End Select
GoTo exitTranslate                       'done

numTranslate:
lType = CLng(vType)                      'convert to long
If lType = 0 Then GoTo exitTranslate     'cannot be zero
x = 1
pointer = 1

If lType < 0 Then                        'negative number
  backward = True                        'search from end
  lType = Abs(lType)
  sSource = Reverse(sSource)
  sFrom = Reverse(sFrom)
  sTo = Reverse(sTo)
End If
  
Do
   pos = InStr(pointer, sSource, sFrom)
   If pos = 0 Then Exit Do
   If x = lType Then
      sSource = Left$(sSource, pos - 1) _
         & sTo & Mid$(sSource, pos + lFrom)
      Exit Do
   End If
   x = x + 1
   pointer = pos + lFrom
Loop
If backward Then sSource = Reverse(sSource)

exitTranslate:
Translate = sSource
End Function

Public Function InsertA(ByVal sSource As String, _
                              sTarget As String, _
                        Optional vPos As Variant, _
                        Optional vPad As Variant) As String
'==========================================================
' InsertA - inserts sTarget into sSource after position vPos
' if vPos is greater than the length of sSource then
'    sSource will be padded with spaces or with (vPad)
' Note: vPos = 0 is the default, and not as efficient
'    as its equivalent: sTarget & sSource
'
' Usage:
'    InsertA("12345", "=")             "=12345"
'    InsertA("12345", "=", 2)          "12=345"
'    InsertA("12345", "=", 7)          "12345  ="
'    InsertA("12345", "=", 7, ".")     "12345..="
'===========----==========================================
Dim lSource     As Long   'length of Source
Dim lSize       As Long   'minimum size needed for sSource
Dim pos         As Long   'vPos converted to long
Dim pad         As String 'vPad converted to string

If sTarget = "" Then GoTo exitInsertA
lSource = Len(sSource)

'validate vPos

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

'validate vPad

If IsMissing(vPad) Then          'default = " "
   pad = " "
ElseIf vPad = "" Then
   pad = " "
Else