StrStuff.mod: Translation to Stony Brook Modula-2

Last updated: 5. 3.1998, 7:41

<*/NOWARN:F*>
IMPLEMENTATION MODULE StrStuff;
(*------------------------------------------------
   STRLIB.C        --- Library module for STRPROG program
                   (c) Charles Petzold,  1996
   StrLib.mod      --- Translation to Stony Brook Modula-2
                   (c) Peter Stadler,    1998
  ------------------------------------------------*)

IMPORT WINUSER;
IMPORT SYSTEM;
IMPORT WIN32;
IMPORT WINGDI;
IMPORT WINX;
IMPORT Str;

(*
#pragma data_seg ("shared")
*)

VAR
  pszStrings : ARRAY[0..MAX_STRINGS-1] OF WIN32.PSTR; (* = NIL *)
  iTotal     : INTEGER = 0;

(*
#pragma data_seg ()
*)

<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END
(*++++*****************************************************************)
PROCEDURE  AddString  (pStringIn   : WIN32.PSTR) : WIN32.BOOL [EXPORT];
(**********************************************************************)
VAR
  hString   :  WIN32.HANDLE;
  pString   :  WIN32.PSTR;
  i         :  INTEGER;
  iLength   :  INTEGER;
  iCompare  :  INTEGER;
BEGIN
     IF (iTotal = MAX_STRINGS - 1) THEN
          RETURN FALSE;
     END;

     iLength := LENGTH(pStringIn^);
     IF (iLength = 0) THEN
          RETURN FALSE;
     END;

     hString := WIN32.CreateFileMapping (SYSTEM.CAST(WIN32.HANDLE, -1), WINX.NIL_SECURITY_ATTRIBUTES, WIN32.PAGE_READWRITE,
                                  0, 1 + iLength, "");
     IF (hString = NIL) THEN
          RETURN FALSE;
     END;

     pString := SYSTEM.CAST(WIN32.PSTR,WIN32.MapViewOfFile (hString, WIN32.FILE_MAP_WRITE, 0, 0, 0));
     Str.Copy(pString^, pStringIn^);
     WINUSER.AnsiUpper (pString^);

     i := iTotal;
     LOOP
          (* should be a comparison of lower-case Strings *)
          iCompare := Str.Compare(pStringIn^, pszStrings[i - 1]^);

          IF (iCompare >= 0) THEN
               EXIT;
          END;
          pszStrings[i] := pszStrings[i - 1];
          DEC(i);
          IF(i<=0) THEN
            EXIT;
          END;
     END;

     pszStrings[i] := pString;

     INC(iTotal);
     RETURN TRUE;
END AddString;
<*/POP*>

<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END

(*++++*****************************************************************)
PROCEDURE  DeleteString  (pStringIn   : WIN32.PSTR) : WIN32.BOOL [EXPORT];
(**********************************************************************)
VAR
  i        :  INTEGER;
  j        :  INTEGER;
  iCompare :  INTEGER;
BEGIN
     IF (LENGTH(pStringIn^)=0) THEN
          RETURN FALSE;
     END;

     i := 0;
     LOOP
          (* should be a comparison of lower-case Strings *)
          iCompare := Str.Compare(pszStrings[i]^, pStringIn^);
          IF (iCompare = 0) THEN
               EXIT;
          END;
          INC(i);
          IF(i>= iTotal) THEN
            EXIT;
          END;
     END;

     (* If given string not in list, RETURN without taking action              *)

     IF (i = iTotal) THEN
          RETURN FALSE;
     END;

     (* Else free memory occupied by the string and adjust list downward       *)

     WIN32.UnmapViewOfFile (pszStrings[i]);

     FOR j := i TO iTotal-1 DO
          pszStrings[j] := pszStrings[j + 1];
     END;

     DEC(iTotal);
     pszStrings[iTotal] := NIL;    (* Destroy unused pointer                *)
     RETURN TRUE;
END DeleteString;
<*/POP*>

<*/PUSH*>
%IF WIN32 %THEN
    <*/CALLS:WIN32SYSTEM*>
%ELSE
    <*/CALLS:WINSYSTEM*>
%END

(*++++*****************************************************************)
PROCEDURE  GetStrings(pfnGetStrCallBack : PSTRCB; pParam : WIN32.PVOID) : INTEGER [EXPORT];
(**********************************************************************)
VAR
  bReturn  :  BOOLEAN;
  i        :  INTEGER;
BEGIN
     FOR i := 0 TO iTotal-1 DO
          bReturn := pfnGetStrCallBack (pszStrings[i], pParam);

          IF (bReturn = FALSE) THEN
               RETURN i + 1;
          END;
     END;
     RETURN iTotal;
END GetStrings;
<*/POP*>
(*
int WINAPI DllMain (HINSTANCE hInstance, DWORD fdwReason, PVOID pvReserved)
*)
VAR
  i    :  INTEGER;
  fdwReason : WIN32.DWORD;

BEGIN
     CASE (fdwReason) OF
          (* Nothing to do when process (or thread) begins                     *)

          | WIN32.DLL_PROCESS_ATTACH :
          | WIN32.DLL_THREAD_ATTACH :
          | WIN32.DLL_THREAD_DETACH :

          (* When process terminates, free any remaining blocks                *)

          | WIN32.DLL_PROCESS_DETACH :
               FOR i := 0 TO iTotal-1 DO
                    WIN32.UnmapViewOfFile (pszStrings[i]);
               END;
     ELSE
     END;
END StrStuff.