home *** CD-ROM | disk | FTP | other *** search
/ Dan Appleman's Visual Bas…s Guide to the Win32 API / Dan.Applmans.Visual.Basic.5.0.Programmers.Guide.To.The.Win32.API.1997.Ziff-Davis.Press.CD / VB5PG32.mdf / vbpg32 / samples4 / ch06 / environ.cls next >
Encoding:
Text File  |  1995-08-13  |  3.1 KB  |  100 lines
  1. VERSION 1.0 CLASS
  2. BEGIN
  3.   MultiUse = -1  'True
  4. END
  5. Attribute VB_Name = "EVClass"
  6. Attribute VB_Creatable = True
  7. Attribute VB_Exposed = True
  8. Option Explicit
  9.  
  10. #If Win32 Then
  11. Private Declare Function GetEnvironmentStrings& Lib "kernel32" Alias "GetEnvironmentStringsA" ()
  12. Private Declare Function GetEnvironmentVariable& Lib "kernel32" Alias "GetEnvironmentVariableA" (ByVal lpName As String, ByVal lpBuffer As String, ByVal nSize As Long)
  13. Private Declare Function SetEnvironmentVariable& Lib "kernel32" Alias "SetEnvironmentVariableA" (ByVal lpName As String, ByVal lpValue As String)
  14. Private Declare Function ExpandEnvironmentStrings& Lib "kernel32" Alias "ExpandEnvironmentStringsA" (ByVal lpSrc As String, ByVal lpDst As String, ByVal nSize As Long)
  15. Private Declare Function FreeEnvironmentStrings Lib "kernel32" Alias "FreeEnvironmentStringsA" (ByVal lpsz As String) As Long
  16. #End If 'WIN32
  17.  
  18. Private datEVBlock&
  19. 'Extracts the idx%'th string from source$, where the
  20. 'substrings are separated by character sep$
  21. 'idx%=0 is the first string
  22. Function ParseAnyString$(source$, ByVal idx%, ByVal sep$)
  23.     Dim nexttab%, basepos%, thispos%
  24.     Dim res$
  25.     basepos% = 1
  26.     thispos% = 0
  27.     If (Len(source$) = 0) Then
  28.         ParseAnyString$ = ""
  29.         Exit Function
  30.     End If
  31.     Do
  32.         nexttab% = InStr(basepos%, source$, sep$)
  33.         If nexttab% = 0 Then nexttab% = Len(source$) + 1
  34.         'Now points to next tab or 1 past end of string
  35.         'The following should never happen
  36.         'If nexttab% = basepos% Then GoTo ptsloop1
  37.  
  38.         If thispos% = idx% Then
  39.             If nexttab% - basepos% - 1 < 0 Then
  40.                 res$ = ""
  41.             Else
  42.                 res$ = Mid$(source$, basepos%, nexttab% - basepos%)
  43.             End If
  44.             Exit Do
  45.         End If
  46. ptsloop1:
  47.         basepos% = nexttab% + 1
  48.         thispos% = thispos% + 1
  49.     Loop While (basepos% <= Len(source$))
  50.     ParseAnyString$ = res$
  51. End Function
  52.  
  53. Private Sub Class_Initialize()
  54.     datEVBlock& = GetEnvironmentStrings&()
  55. End Sub
  56.  
  57.  
  58. Private Sub Class_Terminate()
  59.     Dim dl&
  60.     dl& = FreeEnvironmentStrings(datEVBlock)
  61. End Sub
  62.  
  63.  
  64.  
  65. '
  66. ' Determine the number of strings
  67. Public Function GetStringCount%()
  68.     Dim e$, e2$
  69.     Dim strcnt%
  70.     e$ = agGetStringFrom2NullBuffer(datEVBlock)
  71.     Do
  72.         e2$ = ParseAnyString(e$, strcnt%, Chr$(0))
  73.         Debug.Print e2$
  74.         If e2$ <> "" Then strcnt% = strcnt% + 1
  75.     Loop While e2$ <> ""
  76.     GetStringCount = strcnt%
  77. End Function
  78.  
  79. Public Function GetString$(idx%)
  80.     Dim e$, e2$
  81.     Dim startpos%, newpos%
  82.     e$ = agGetStringFrom2NullBuffer(datEVBlock)
  83.     e2$ = ParseAnyString(e$, idx%, Chr$(0))
  84.     If Left$(e2$, 1) = "=" Then startpos% = 2 Else startpos% = 1
  85.     newpos% = InStr(startpos%, e2$, "=")
  86.     If newpos% > 0 Then e2$ = Left$(e2$, newpos% - 1)
  87.     GetString$ = e2$
  88. End Function
  89.  
  90. '
  91. ' Retreives the value of an environment string
  92. '
  93. Public Function GetStringValue$(ByVal envstr$)
  94.     Dim dl&
  95.     Dim buf$
  96.     buf$ = String$(2048, 0)
  97.     dl& = GetEnvironmentVariable(envstr$, buf$, 2047)
  98.     If dl& > 0 Then GetStringValue$ = Left$(buf$, dl&)
  99. End Function
  100.