MODULE DiaRegTest;

   IMPORT  SYSTEM, Log, WinApi, HostRegistry;
   
   TYPE
      StringPtr = POINTER TO ARRAY [untagged] OF CHAR;
   
   PROCEDURE Home*;
      VAR r, len, type, res: INTEGER;  adr: SHORTCHAR;  i: INTEGER;
      str2, data: StringPtr; hndl: WinApi.HANDLE;
   BEGIN
      res := WinApi.RegOpenKeyW(WinApi.HKEY_CURRENT_USER, "Volatile Environment", hndl);
      len := 1024;
      res := WinApi.RegQueryValueExW(hndl, "USERNAME", NIL, type, adr, len);
      
      Log.String("res: "); Log.Int(res);
      Log.String(" type: "); Log.Int(type);
      Log.String(" len: "); Log.Int(len);Гипотеза
      Log.Ln;
      
      Log.String("data adr: "); Log.Int(SYSTEM.ADR(adr));
      Log.Ln;
      
      str2 := SYSTEM.VAL(StringPtr, SYSTEM.ADR(adr));
      Log.String(str2$); Log.Ln;
      
   END Home;

END DiaRegTest.

MODULE DiaRegTest;
   
   IMPORT SYSTEM, Log, WinApi;

   PROCEDURE Home* ;
      VAR
         len, type, res: INTEGER;
         data: ARRAY 512 OF CHAR;
         hkey: WinApi.HANDLE;
   BEGIN
      res := WinApi.RegOpenKeyW(WinApi.HKEY_CURRENT_USER, "Volatile Environment", hkey);
      IF res = 0 THEN
         len := LEN(data) * 2;
         res := WinApi.RegQueryValueExW(hkey, "USERNAME", NIL, type, SYSTEM.VAL(SHORTCHAR, data[0]), len);
         Log.String("res: "); Log.Int(res); Log.Tab;
         Log.String(" type: "); Log.Int(type); Log.Tab; Log.String(" len: "); Log.Int(len DIV 2);Log.Ln;
         Log.String('data:'); Log.String(data); Log.Ln;
         res := WinApi.RegCloseKey(hkey);
      ELSE
         Log.String('open key error!'); Log.Tab; Log.Int(res); Log.Ln;
      END;
   END Home;

END DiaRegTest.

MODULE Env;

   TYPE
      String* = POINTER TO ARRAY OF CHAR;
      Hook* = POINTER TO ABSTRACT RECORD END;
   
   VAR hook : Hook;
   
   (* узнать значение переменной.   name - название переменной *)
   PROCEDURE (h: Hook) Get- (IN name : ARRAY OF CHAR) : String, NEW, ABSTRACT;
   (* задать значение переменной.   name - название переменной, val - значение *)
   PROCEDURE (h: Hook) Set- (IN name, val : ARRAY OF CHAR), NEW, ABSTRACT;
   
   PROCEDURE SetHook*(h : Hook);
   BEGIN
      hook := h
   END SetHook;
   
   PROCEDURE Get*(IN name : ARRAY OF CHAR) : String;
   BEGIN
      RETURN hook.Get(name)
   END Get;
   
   PROCEDURE Set*(IN name, val : ARRAY OF CHAR);
   BEGIN
      hook.Set(name, val)
   END Set;
   
END Env.

MODULE HostEnv;
   IMPORT Env, WinApi, SYSTEM;
   
   CONST MaxLen = 32767;
   
   TYPE
      Hook = POINTER TO RECORD(Env.Hook)
         ValueLen- : INTEGER
      END;
      SStr = POINTER TO ARRAY OF SHORTCHAR;
   
   VAR
      res : INTEGER;
      hook : Hook;
   
   PROCEDURE ToShort(IN str : ARRAY OF CHAR) : SStr;
      VAR  ret : SStr;
         i, len : INTEGER;
   BEGIN
      i := 0; len := LEN(str$); NEW( ret, len + 1 );
      WHILE i < len DO
         ret[i] := SHORT( str[i] );
         i := i + 1
      END;
      ret[i] := 0X;
      RETURN ret
   END ToShort;
   
   PROCEDURE ToLong(str : SStr) : Env.String;
      VAR  ret : Env.String;
         i, len : INTEGER;
   BEGIN
      i := 0; len := LEN(str$); NEW( ret, len + 1 );
      WHILE i < len DO
         ret[i] := LONG( str[i] );
         i := i + 1
      END;
      ret[i] := 0X;
      RETURN ret
   END ToLong;
   
   (* узнать значение переменной *)
   PROCEDURE (h: Hook) Get(IN name : ARRAY OF CHAR) : Env.String;
      VAR sname, sval : SStr;
         len : INTEGER;
         ret : Env.String;
   BEGIN
      sname := ToShort(name);
      len := 256;
      NEW( sval, len );
      res := WinApi.GetEnvironmentVariable(sname^, sval^, len);
      ret := ToLong(sval);
      RETURN ret
   END Get;
   
   (* задать значение переменной *)
   PROCEDURE (h: Hook) Set(IN name, val: ARRAY OF CHAR);
      VAR sname, sval : POINTER TO ARRAY OF SHORTCHAR;
   BEGIN
      sname := ToShort(name);
      sval := ToShort(val);
      res := WinApi.SetEnvironmentVariable(sname^, sval^)
   END Set;
   
   (* Задать размер значения переменной.
      Используется при получении значения из ОС.
      Если возвращено значение больше заданного размера, то хвост отсекается. *)
   PROCEDURE (h: Hook) SetValLen(i : INTEGER), NEW;
   BEGIN
      (* тихое игнорирование приказа. Нужно что-то придумать *)
      IF (i >= 0) & (i < MaxLen) THEN
         h.ValueLen := i + 1 (* учитываем нолик в конце строки *)
      END
   END SetValLen;
   
   PROCEDURE Init*(len : INTEGER);
   BEGIN
      NEW( hook );
      hook.ValueLen := len;
      Env.SetHook(hook)
   END Init;
   
BEGIN
   Init(256)
END HostEnv.