home *** CD-ROM | disk | FTP | other *** search
/ Planet Source Code Jumbo …e CD Visual Basic 1 to 7 / 1_2002.ISO / Data / Zips / CODE_UPLOAD79837202000.psc / modStringFuntions.bas < prev    next >
Encoding:
BASIC Source File  |  1998-07-21  |  5.2 KB  |  201 lines
  1. Attribute VB_Name = "modStringFuntions"
  2.  
  3. 'All code contained within this module is FREEWARE and may be freely
  4. 'distributed and used within other applications providing that
  5. '   i)No modifications are made to the original code
  6. '
  7. '  ii)No modifications are made to the comments
  8. '
  9. ' iii)Credit is given in the applications about box or readme file.
  10. '
  11. 'Neil Ramsbottom
  12.  
  13. Option Explicit
  14.  
  15. Public Function ReplaceCommandTag(strText As String, strTagName As String, strTagVal As String) As String
  16.  
  17. 'Author:    Neil Ramsbottom
  18. 'Date:      29/01/2000
  19. 'Purpose:   Replaces the value of a command tag with a string.
  20. 'WWW:       http://www.nramsbottom.co.uk
  21. 'Example:   MsgBox (ReplaceCommandTag("The date today is %DATE%.","DATE",Format$(Date,"mm/dd/yyyy")))
  22. 'Notes:     This function is case sensitive, so many different values can be used, i.e. DATE, date, dATE, DaTE
  23. '           I wrote this to help in the generation of 404 errors on a web server, where the Date and Time needed
  24. '           to be added to a public string, before being sent to a browser.
  25.  
  26. 'This module was written before I had VB6, but VB6 has the Replace() function
  27.  
  28. Dim i As Integer
  29.  
  30. Dim strTmpVal As String
  31. Dim strTmpVal2 As String
  32.  
  33. If strText = "" Or Len(strText) = 0 Or strTagName = "" Or Len(strTagName) = 0 Or strTagVal = "" Or Len(strTagVal) = 0 Then
  34.     ReplaceCommandTag = strText
  35.     Exit Function
  36. End If
  37.  
  38. For i = 1 To Len(strText)
  39.     If Mid(strText, i, 1) = "%" Then
  40.         'If the current character and strTagName and "%" =
  41.         '"%" and strTagName &"%" then do . . .
  42.         If Mid(strText, i, Len(strTagName & "%") + 1) = "%" & strTagName & "%" Then
  43.             strTmpVal = Mid(strText, 1, i - 1) 'Store all of the string before the first %
  44.             strTmpVal2 = Mid(strText, i + Len(strTagName) + 2) 'Store all of the string after the last "%"
  45.             ReplaceCommandTag = strTmpVal & strTagVal & strTmpVal2 'Reconstruct the string and return value
  46.             Exit Function 'Exits after first change
  47.         End If
  48.     End If
  49. Next i
  50.  
  51. ReplaceCommandTag = strText
  52.  
  53. End Function
  54.  
  55. Public Function InvertSlashes(strText As String) As String
  56.  
  57. 'Author:    Neil Ramsbottom
  58. 'Date:      28/01/2000
  59. 'Purpose:   Inverts any slashes in a string.
  60. 'Example:   Passing "c:\windows/desktop" will return "C:/windows\desktop"
  61.  
  62. 'Pre-VB6 Function
  63.  
  64. Dim i As Integer
  65.  
  66. For i = 1 To Len(strText)
  67.  
  68.     If Mid(strText, i, 1) = "\" Then
  69.         Mid(strText, i, 1) = "/"
  70.     ElseIf Mid(strText, i, 1) = "/" Then
  71.         Mid(strText, i, 1) = "\"
  72.     End If
  73.  
  74. Next i
  75.  
  76. InvertSlashes = strText
  77.  
  78. End Function
  79.  
  80. Public Function InvertBackSlashes(strText As String) As String
  81.  
  82. 'Author:    Neil Ramsbottom
  83. 'Date:      29/01/2000
  84. 'Purpose:   Inverts any backslashes within a string
  85.  
  86. 'Pre-VB6 Function
  87.  
  88. Dim i As Integer
  89.  
  90. If strText = "" Or Len(strText) = 0 Then
  91.     InvertBackSlashes = strText
  92.     Exit Function
  93. End If
  94.  
  95. For i = 1 To Len(strText)
  96.  
  97.     If Mid(strText, i, 1) = "\" Then
  98.         Mid(strText, i, 1) = "/"
  99.     End If
  100.     
  101. Next i
  102.  
  103. InvertBackSlashes = strText
  104.  
  105. End Function
  106.  
  107. Public Function InvertForwardSlashes(strText As String) As String
  108.  
  109. 'Author:    Neil Ramsbottom
  110. 'Date:      29/01/2000
  111. 'Purpose:   Inverts any forward slashes within a string
  112.  
  113. 'Pre-VB6 Function
  114.  
  115. Dim i As Integer
  116.  
  117. If strText = "" Or Len(strText) = 0 Then
  118.     InvertForwardSlashes = strText
  119.     Exit Function
  120. End If
  121.  
  122. For i = 1 To Len(strText)
  123.  
  124.     If Mid(strText, i, 1) = "/" Then
  125.         Mid(strText, i, 1) = "\"
  126.     End If
  127.     
  128. Next i
  129.  
  130. InvertForwardSlashes = strText
  131.  
  132. End Function
  133.  
  134. Public Function WindowsDirectory() As String
  135.  
  136. 'Author:    Neil Ramsbottom
  137. 'Date:      31/01/2000
  138. 'Purpose:   Returns the windows directory
  139. 'Notes:     I know it does use the API, but I needed a quick fix
  140. '           but there will be a faster API version soon.
  141.  
  142. Dim strTmpVal As String
  143.  
  144. strTmpVal = Environ$("WINDIR") 'Windows sets this so it IS correct
  145.  
  146. If Right(strTmpVal, 1) <> "\" Then
  147.     strTmpVal = strTmpVal & "\"
  148. End If
  149.  
  150. WindowsDirectory = strTmpVal
  151.  
  152. End Function
  153. Public Function TempDirectory() As String
  154.  
  155. 'Author:    Neil Ramsbottom
  156. 'Date:      31/01/2000
  157. 'Purpose:   Returns the temp directory
  158. 'Notes:     I know it does use the API, but I needed a quick fix
  159. '           but there will be a faster API version soon.
  160.  
  161. Dim strTmpVal As String
  162.  
  163. strTmpVal = Environ$("TEMP") 'Windows sets this so it IS correct
  164.  
  165. If Right(strTmpVal, 1) <> "\" Then
  166.     strTmpVal = strTmpVal & "\"
  167. End If
  168.  
  169. TempDirectory = strTmpVal
  170.  
  171. End Function
  172. Public Function GetAppPath() As String
  173.  
  174. 'Author:    Neil Ramsbottom
  175. 'Date:      31/01/2000
  176. 'Purpose:   Returns App.Path with a black slash ALWAYS (if app.path was root,
  177. '           it would return "C:", so a filename will not work i.e "C:data.dat").
  178. '           Yeah, that will work in explorer, but not in VB5
  179.  
  180. If Right(App.Path, 1) <> "\" Then
  181.     GetAppPath = App.Path & "\"
  182. Else
  183.     GetAppPath = App.Path
  184. End If
  185.     
  186. End Function
  187. Public Function LoadResStr(intResId As Integer) As String
  188.  
  189. 'Author:    Neil Ramsbottom
  190. 'Date:      02/02/2000
  191. 'Purpose:   The LoadResString function with error checking
  192.  
  193. 'Just cos its got error supression
  194.  
  195. On Error Resume Next
  196.  
  197. LoadResStr = LoadResString(intResId)
  198.  
  199.  
  200. End Function
  201.