/*--------------------------------------------
   Environ.o2bas -- Environment List Box
   The original code (c) Charles Petzold, 1998
  --------------------------------------------*/
$ filename "Environ.exe"
'uses rtl32
'uses rtl64

uses corewinW
'uses console

% SM_CXVSCROLL 2
% SS_LEFT 0


indexbase 0

function replace(string t,w,r) as string
========================================
'
int a,b,lw,lr
string s=t
'
lw=len(w)
lr=len(r)
a=1
do
  a=instr(a,s,w)
  if a=0 then exit do
  s=left(s,a-1)+r+mid(s,a+lw)
  a+=lr
end do
return s
end function


% ID_LIST     1
% ID_TEXT     2

sys hInstance = GetModuleHandle (NULL)
int iCmdShow = SW_SHOW


function WinMain () as sys
     wstring      szAppName = L"Environ"
     sys          hwnd
     MSG          msg
     WNDCLASS     wndclass
     
     wndclass.style         = CS_HREDRAW or CS_VREDRAW
     wndclass.lpfnWndProc   = @WndProc
     wndclass.cbClsExtra    = 0
     wndclass.cbWndExtra    = 0
     wndclass.hInstance     = hInstance
     wndclass.hIcon         = LoadIcon (NULL, IDI_APPLICATION)
     wndclass.hCursor       = LoadCursor (NULL, IDC_ARROW)
     wndclass.hbrBackground = GetStockObject (WHITE_BRUSH)
     wndclass.lpszMenuName  = NULL
     wndclass.lpszClassName = strptr szAppName

     if not RegisterClass (&wndclass) then
          MessageBox (NULL, L"Cannot RegisterClass wndclass",
                      szAppName, MB_ICONERROR)
          return 0
     end if
     
     hwnd = CreateWindowEx (0,
                            szAppName, L"Environment List Box",
                            WS_OVERLAPPEDWINDOW,
                            CW_USEDEFAULT, CW_USEDEFAULT,
                            CW_USEDEFAULT, CW_USEDEFAULT,
                            NULL, NULL, hInstance, NULL)
     
     if not hwnd then                       
          MessageBox (NULL, L"Cannot Create Main Window",
                      szAppName, MB_ICONERROR)
          return 0
     end if
     
     ShowWindow (hwnd, iCmdShow)
     UpdateWindow (hwnd)
     
     while GetMessage (&msg, NULL, 0, 0)
          TranslateMessage (&msg)
          DispatchMessage (&msg)
     wend

end function

sub FillListBox (sys hwndList) 
     sys pVarBlock   
     pVarBlock = GetEnvironmentStringsA ()   // Get pointer to environment block
word *w : @w=GetEnvironmentStrings ()   // Get pointer to environment block
wstring sw
sys bw=@w 'start of words
sys ew    'end of var name
int a
do
  if w=61
    ew=@w
  elseif w=0 'end of varname=content pair
    wchar*wc
    @wc=bw
    sw=left(wc,(ew-bw)\2)'+wchr(13,10)
    SendMessage (hwndList, LB_ADDSTRING, 0, sw)
    bw=@w+2
    if w[1]=0 ' \0 \0 end of list 
      exit do
    endif
  endif
  a++
  @w+=2
loop
'print sw
/*
     string crlf = chr(13,10)
     byte b at (pVarBlock)
     string envBlock
     string tmpString
 
     while 1
        if b=0 then
           'search for 00 at the end
           if b[1]=0  then tmpString += chr(0) : exit while
           tmpString += chr(b)
        else   
           tmpString += chr(b)
        end if   
        @b++
     wend
'print tmpString ': waitkey
     'find first 0
     int pos1=instr(tmpString, chr(0))
     tmpString = mid(tmpString,pos1+1)
     'find __COMPAT_LAYER=  (64-bit) and exclude
     pos1=instr(tmpString, "__COMPAT_LAYER=")
     if pos1 then tmpString = left(tmpString,pos1-1)
'printl tmpstring : waitkey     
 
     'find =
     int pos2
     pos1 = 1
     ' create envBlock
     while 1
        pos2=instr(pos1, tmpString, "=")
        if pos2 = 0 then exit while
        'add Varname
        envBlock += mid(tmpString, pos1, pos2-pos1) + crlf
        'skip Value       
        pos2=instr(pos1+1, tmpString, chr(0))
        if pos2 = 0 then exit while
        pos1 = pos2 + 1 : pos2 = pos1
     wend
     envBlock = left(envBlock, len(envBlock)-1)
     ' set a flag     
     envBlock += crlf + "EndOfEnvBlock"

     pos1=1
     string VarName
     'build Listbox
     while 1
        pos2 = instr(pos1, envBlock, crlf)
        if pos2 = 0 then exit while
        VarName = mid(envBlock, pos1, pos2-pos1)
        if VarName = "EndOfEnvBlock" then exit while
        SendMessage (hwndList, LB_ADDSTRING, 0, wstring rtrim VarName)
        pos1 = pos2+2 : pos2= pos1
     wend
*/   
end sub

function WndProc (sys hwnd, uint message, sys wParam, sys lParam) as sys callback
     static sys  hwndList, hwndText
     int         iIndex, iLength, cxChar, cyChar
     wzstring    pVarName[100]
     wzstring    pVarValue[800]
 

     select case message
     case WM_CREATE
          cxChar = LOWORD (GetDialogBaseUnits ())
          cyChar = HIWORD (GetDialogBaseUnits ())

               // Create listbox and static text windows.
         
          hwndList = CreateWindowEx (0,
                              L"listbox", NULL,
                              WS_CHILD or WS_VISIBLE or LBS_STANDARD,
                              cxChar, cyChar * 3,
                              cxChar * 16 + GetSystemMetrics (SM_CXVSCROLL),
                              cyChar * 15,
                              hwnd, ID_LIST,
                              GetWindowLong (hwnd, GWL_HINSTANCE),
                              NULL)
          if not hwndList then                       
              MessageBox (NULL, L"Cannot Create ListBox",
                          L"Error!" , MB_ICONERROR)
              return 0
          end if
         
          hwndText = CreateWindowEx (0,
                              L"static", NULL,
                              WS_CHILD or WS_VISIBLE or SS_LEFT,
                              cxChar, cyChar,
                              GetSystemMetrics (SM_CXSCREEN), cyChar,
                              hwnd, ID_TEXT,
                              GetWindowLong (hwnd, GWL_HINSTANCE),
                              NULL)
          if not hwndText then                       
              MessageBox (NULL, L"Cannot Create Label",
                          L"Error!", MB_ICONERROR)
              return 0
          end if

          FillListBox (hwndList) 
         
     case WM_SETFOCUS
          SetFocus (hwndList) 
         
     case WM_COMMAND
          if (LOWORD (wParam) == ID_LIST && HIWORD (wParam) == LBN_SELCHANGE) then
                    // Get current selection.
               iIndex  = SendMessage (hwndList, LB_GETCURSEL, 0, 0)
               iLength = SendMessage (hwndList, LB_GETTEXTLEN, iIndex, 0) + 1 
               SendMessage (hwndList, LB_GETTEXT, iIndex, @pVarName)

                    // Get environment string.
               iLength = GetEnvironmentVariable (pVarName, NULL, 0) 
               GetEnvironmentVariable (@pVarName, @pVarValue, iLength)

                    // Show it in window.               
               SetWindowText (hwndText, @pVarValue)
          end if
          return 0

     case WM_DESTROY
          PostQuitMessage (0) 
     end select
     return DefWindowProc (hwnd, message, wParam, lParam)
end function

WinMain()

