home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / magazine / wint1_92 / q&a / zuck.txt
Text File  |  1991-12-23  |  2KB  |  70 lines
  1. Listing 1. List of the Environ$ function in WinWord Basic
  2.  
  3. 'ENVIRON$ function for WinWord BASIC
  4. 'by Jonathan Zuck
  5. Declare Function GetDosEnvironment Lib "Kernel.EXE"() As Long
  6. Declare Function AnsiUpper$ Lib "User.EXE"(Seg As Integer, Addr As Integer)
  7.  
  8. Function Environ$(Var$)
  9.     Search$ = UCase$(Var$)     'Uppercase for easy comparisons    
  10.     SLen = Len(Search$)        'Save the length of the string     
  11.     Env = GetDosEnvironment    'Get a pointer to the E table      
  12.     Seg = Int(Env / 65536) + 1 'Calculate the segment
  13.     Addr = - 2                 'Fudge Addr so that, when added    
  14.     FLen = 2                   'to Flen, it results in zero
  15.     Success = 0                'Assume failure
  16.  
  17.     'Loop until we have a match or no more variables
  18.     While Left$(Found$, SLen) <> Search$ And FLen > 1
  19.          Addr = Addr + FLen             'Increment the pointer    
  20.          Found$ = AnsiUpper$(Seg, Addr) 'Convert LP to string     
  21.          FLen = Len(Found$) + 1         'Adjust for NULL
  22.     Wend
  23.  
  24.     'If we actually found a match, and not just the end of the table 
  25.     If FLen > 1 Then
  26.          Offset = InStr(Found$, "=") + 1 'Find the data
  27.          Environ$ = Right$(Found$, FLen - Offset)
  28.     Else
  29.          Environ$ = ""
  30.     End If
  31. End Function
  32.  
  33. Listing 2. A WinWord macro to test the Environ$ function
  34.  
  35. Sub MAIN
  36.      GetVar$ = UCase$(InputBox$("Environment Variable"))
  37.      EnvVar$ = Environ$(GetVar$)
  38.      If Len(EnvVar$)  = 0 Then EnvVar$ = "Not Found!"
  39.      MsgBox EnvVar$, GetVar$, 64
  40. End Sub
  41.  
  42. Listing 3: The case-sensitive Environ$ function
  43.  
  44. Declare Function GetDosEnvironment Lib "KERNEL.EXE"() As Long
  45. Declare Sub LStrCpy Lib "Kernel.EXE"(Buff$, Seg As Integer, Addr As Integer)
  46.  
  47. Function Environ$(Var$)
  48.      Env = GetDosEnvironment
  49.      Seg = Int(Env / 65536) + 1
  50.      Addr = - 2
  51.      Search$ = UCase$(Var$)
  52.      SLen = Len(Search$)
  53.      FLen = 2
  54.      Success = 0
  55.      Buff$ = String$(128, " ")
  56.      While Left$(Found$, SLen) <> Search$ And FLen > 1
  57.           Addr = Addr + FLen
  58.           LStrCpy(Buff$, Seg, Addr)
  59.           Found$ = UCase$(Buff$)
  60.           FLen = Len(Found$) + 1
  61.      Wend
  62.      If FLen > 1 Then
  63.           Offset = InStr(Found$, "=") + 1
  64.           Environ$ = Right$(Buff$, FLen - Offset)
  65.      Else
  66.           Environ$ = ""
  67.      End If
  68. End Function
  69.  
  70.