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