فهرست منبع

+ New unit dos.pp for Mac OS

olle 21 سال پیش
والد
کامیت
a01ae11431
1فایلهای تغییر یافته به همراه917 افزوده شده و 0 حذف شده
  1. 917 0
      rtl/macos/dos.pp

+ 917 - 0
rtl/macos/dos.pp

@@ -0,0 +1,917 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2004 by Olle Raab and
+    members of the Free Pascal development team
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+Unit Dos;
+Interface
+
+Uses
+  macostp;
+  
+
+Const
+  {Max PathName Length for files}
+  FileNameLen=255;
+
+Type
+    SearchRec = packed record
+        Attr: Byte;       {attribute of found file}
+        Time: LongInt;    {last modify date of found file}
+        Size: LongInt;    {file size of found file}
+        Reserved: Word;   {future use}
+        Name: string[FileNameLen]; {name of foundfile}
+        SearchSpec: string[FileNameLen]; {search pattern}
+        NamePos: Word;    {end of path,start of name position}
+
+        {MacOS specific params, private, do not use:}
+        paramBlock: CInfoPBRec;
+        searchFSSpec: FSSpec;
+        searchAttr: Byte;  {attribute we are searching for}
+        exactMatch: Boolean;
+      end;
+
+{$i dosh.inc}
+
+Implementation
+
+{TODO Obtain disk size and disk free values for volumes > 2 GB.
+ For this, PBXGetVolInfoSync can be used. However, this function
+ is not available on older versions of Mac OS, so the function has
+ to be weak linked. An alternative is to directly look into the VCB
+ (Volume Control Block), but since this is on low leveel it is a
+ compatibility risque.}
+
+{TODO Perhaps make SearchRec.paramBlock opaque, so that uses macostp;
+ is not needed in the interface part.}
+
+{TODO Perhaps add some kind of "Procedure AddDisk" for accessing other
+ volumes. At lest accessing the possible disk drives with
+ driver number 1 and 2 should be easy.}
+
+{TODO Perhaps implement Exec with Apple Events, calling ToolServer.}
+
+
+{TODO Perhaps use LongDateTime for time functions. But the function
+ calls must then be weak linked.}
+
+Uses
+  macutils,
+  unixutil {for FNMatch};
+
+function MacTimeToDosPackedTime(macfiletime: UInt32): Longint;
+var
+  mdt: DateTimeRec; {Mac OS datastructure}
+  ddt: Datetime;    {Dos OS datastructure}
+  dospackedtime: Longint;
+
+begin
+  SecondsToDate(macfiletime, mdt);
+  with ddt do
+    begin
+      year := mdt.year;
+      month := mdt.month;
+      day := mdt.day;
+      hour := mdt.hour;
+      min := mdt.minute;
+      sec := mdt.second;
+    end;
+  Packtime(ddt, dospackedtime);
+  MacTimeToDosPackedTime:= dospackedtime;
+end;
+
+
+{******************************************************************************
+                        --- Info / Date / Time ---
+******************************************************************************}
+
+function DosVersion:Word;
+
+begin
+  DosVersion:=
+    (macosSystemVersion and $FF00) or
+    ((macosSystemVersion and $00F0) shr 4);
+end;
+
+procedure GetDate (var year, month, mday, wday: word);
+
+  var
+    d: DateTimeRec;
+
+begin
+  Macostp.GetTime(d);
+  year := d.year;
+  month := d.month;
+  mday := d.day;
+  wday := d.dayOfWeek - 1;  {1-based on mac}
+end;
+
+procedure GetTime (var hour, minute, second, sec100: word);
+
+  var
+    d: DateTimeRec;
+
+begin
+  Macostp.GetTime(d);
+  hour := d.hour;
+  minute := d.minute;
+  second := d.second;
+  sec100 := 0;
+end;
+
+procedure Packtime(var t : datetime;var p : longint);
+Begin
+  p:=(t.sec shr 1)+(t.min shl 5)+(t.hour shl 11)+(t.day shl 16)+(t.month shl 21)+((t.year-1980) shl 25);
+End;
+
+procedure Unpacktime(p : longint;var t : datetime);
+Begin
+  t.sec:=(p and 31) shl 1;
+  t.min:=(p shr 5) and 63;
+  t.hour:=(p shr 11) and 31;
+  t.day:=(p shr 16) and 31;
+  t.month:=(p shr 21) and 15;
+  t.year:=(p shr 25)+1980;
+End;
+
+Procedure SetDate(Year, Month, Day: Word);
+
+  var
+    d: DateTimeRec;
+
+Begin
+  Macostp.GetTime(d);
+  d.year := year;
+  d.month := month;
+  d.day := day;
+  Macostp.SetTime(d)
+End;
+
+Procedure SetTime(Hour, Minute, Second, Sec100: Word);
+
+  var
+    d: DateTimeRec;
+
+Begin
+  Macostp.GetTime(d);
+  d.hour := hour;
+  d.minute := minute;
+  d.second := second;
+  Macostp.SetTime(d)
+End;
+
+{******************************************************************************
+                               --- Exec ---
+******************************************************************************}
+
+Procedure Exec (Const Path: PathStr; Const ComLine: ComStr);
+Begin
+  DosError:=8; //TODO A better error sometime
+End;
+
+Function DosExitCode: Word;
+Begin
+  DosExitCode := 3; //Indicate failure TODO a better error sometime.
+End;
+
+{******************************************************************************
+                               --- Disk ---
+******************************************************************************}
+
+{If drive is 0 the free space on the volume of the working directory is returned.
+ If drive is 1 or 2, the free space on the first or second floppy disk is returned.
+ If drive is 3 the free space on the boot volume is returned.
+ If the free space is > 2 GB, then 2 GB is reported.}
+Function DiskFree(drive: Byte): Int64;
+
+var
+  myHPB: HParamBlockRec;
+  myErr: OSErr;
+
+begin
+	myHPB.ioNamePtr := NIL;
+	myHPB.ioVolIndex := 0;
+  case drive of
+    0: myHPB.ioVRefNum := GetWorkingDirectoryVRefNum;
+    1: myHPB.ioVRefNum := 1;
+    2: myHPB.ioVRefNum := 2;
+    3: myHPB.ioVRefNum := macosBootVolumeVRefNum;
+    else
+      begin
+        Diskfree:= -1;
+        Exit;
+      end;
+  end;
+
+  myErr := PBHGetVInfoSync(@myHPB);
+
+  if myErr = noErr then
+    Diskfree := myHPB.ioVAlBlkSiz * myHPB.ioVFrBlk
+  else
+    Diskfree:= -1;
+End;
+
+{If drive is 0 the size of the volume of the working directory is returned.
+ If drive is 1 or 2, the size of the first or second floppy disk is returned.
+ If drive is 3 the size of the boot volume is returned.
+ If the actual size is > 2 GB, then 2 GB is reported.}
+Function DiskSize(drive: Byte): Int64;
+
+var
+  myHPB: HParamBlockRec;
+  myErr: OSErr;
+
+Begin
+	myHPB.ioNamePtr := NIL;
+	myHPB.ioVolIndex := 0;
+  case drive of
+    0: myHPB.ioVRefNum := GetWorkingDirectoryVRefNum;
+    1: myHPB.ioVRefNum := 1;
+    2: myHPB.ioVRefNum := 2;
+    3: myHPB.ioVRefNum := macosBootVolumeVRefNum;
+    else
+      begin
+        DiskSize:= -1;
+        Exit;
+      end;
+  end;
+
+  myErr := PBHGetVInfoSync(@myHPB);
+
+  if myErr = noErr then
+    DiskSize := myHPB.ioVAlBlkSiz * myHPB.ioVNmAlBlks
+  else
+    DiskSize:=-1;
+End;
+
+{******************************************************************************
+                       --- Findfirst FindNext ---
+******************************************************************************}
+
+(*
+  {The one defined in Unixutils.pp is used instead}
+
+  function FNMatch (const Pattern, Name: string): Boolean;
+
+    var
+      LenPat, LenName: longint;
+
+    function DoFNMatch (i, j: longint): Boolean;
+
+      var
+        Found: boolean;
+
+    begin
+      Found := true;
+      while Found and (i <= LenPat) do
+        begin
+          case Pattern[i] of
+            '?': 
+              Found := (j <= LenName);
+            '*': 
+              begin
+                                {find the next character in pattern, different of ? and *}
+                while Found and (i < LenPat) do
+                  begin
+                    i := i + 1;
+                    case Pattern[i] of
+                      '*': 
+                        ;
+                      '?': 
+                        begin
+                          j := j + 1;
+                          Found := (j <= LenName);
+                        end;
+                      otherwise
+                        Found := false;
+                    end;
+                  end;
+                        {Now, find in name the character which i points to, if the * or ?}
+                        {wasn 't the last character in the pattern, else, use up all the}
+                        {chars in name }
+                Found := true;
+                if (i <= LenPat) then
+                  begin
+                    repeat
+                                        {find a letter (not only first !) which maches pattern[i]}
+                      while (j <= LenName) and (name[j] <> pattern[i]) do
+                        j := j + 1;
+                      if (j < LenName) then
+                        begin
+                          if DoFnMatch(i + 1, j + 1) then
+                            begin
+                              i := LenPat;
+                              j := LenName;{we can stop}
+                              Found := true;
+                            end
+                          else
+                            j := j + 1;{We didn't find one, need to look further}
+                        end;
+                    until (j >= LenName);
+                  end
+                else
+                  j := LenName;{we can stop}
+              end;
+            otherwise {not a wildcard character in pattern}
+              Found := (j <= LenName) and (pattern[i] = name[j]);
+          end;
+          i := i + 1;
+          j := j + 1;
+        end;
+      DoFnMatch := Found and (j > LenName);
+    end;
+
+  begin {start FNMatch}
+    LenPat := Length(Pattern);
+    LenName := Length(Name);
+    FNMatch := DoFNMatch(1, 1);
+  end;
+
+*)
+
+  function GetFileAttrFromPB (var paramBlock: CInfoPBRec): Word;
+
+    var
+      isLocked, isInvisible, isDirectory, isNameLocked: Boolean;
+      attr: Word;
+
+    {NOTE "nameLocked" was in pre-System 7 called "isSystem".
+    It is used for files whose name and icon cannot be changed by the user,
+    that is essentially system files. However in System 9 the folder
+    "Applications (Mac OS 9)" also has this attribute, and since this is
+    not a system file in traditional meaning, we will not use this attribute
+    as the "sysfile" attribute.}
+
+  begin
+    with paramBlock do
+      begin
+        attr := 0;
+
+        isDirectory := (ioFlAttrib and $10) <> 0;
+        if isDirectory then
+          attr := (attr or directory);
+
+        isLocked := (ioFlAttrib and $01) <> 0;
+        if isLocked then
+          attr := (attr or readonly);
+
+        if not isDirectory then
+          begin
+            isInvisible := (ioFlFndrInfo.fdFlags and 16384) <> 0;
+            (* isNameLocked := (ioFlFndrInfo.fdFlags and 4096) <> 0; *)
+          end
+        else
+          begin
+            isInvisible := (ioDrUsrWds.frFlags and 16384) <> 0;
+            (* isNameLocked := (ioDrUsrWds.frFlags and 4096) <> 0; *)
+          end;
+
+        if isInvisible then
+          attr := (attr or hidden);
+
+        (*
+        if isNameLocked then
+          attr := (attr or sysfile); 
+        *)
+
+        GetFileAttrFromPB := attr;
+      end;
+  end;
+
+  procedure SetPBFromFileAttr (var paramBlock: CInfoPBRec; attr: Word);
+
+  begin
+    with paramBlock do
+      begin
+        (*
+        {Doesn't seem to work, despite the documentation.}
+        {Can instead be set by FSpSetFLock/FSpRstFLock}
+        if (attr and readonly) <> 0 then
+          ioFlAttrib := (ioFlAttrib or $01)
+        else
+          ioFlAttrib := (ioFlAttrib and not($01));
+        *)
+
+        if (attr and hidden) <> 0 then
+          ioFlFndrInfo.fdFlags := (ioFlFndrInfo.fdFlags or 16384)
+        else
+          ioFlFndrInfo.fdFlags := (ioFlFndrInfo.fdFlags and not(16384))
+      end;
+  end;
+
+  function GetFileSizeFromPB (var paramBlock: CInfoPBRec): Longint;
+
+  begin
+    with paramBlock do
+      if ((ioFlAttrib and $10) <> 0) then {if directory}
+        GetFileSizeFromPB := 0
+      else
+        GetFileSizeFromPB := ioFlLgLen + ioFlRLgLen;    {Add length of both forks}
+  end;
+
+  function DoFindOne (var spec: FSSpec; var paramBlock: CInfoPBRec): Integer;
+
+    var
+      err: OSErr;
+
+  begin
+    with paramBlock do
+      begin
+        ioVRefNum := spec.vRefNum;
+        ioDirID := spec.parID;
+        ioNamePtr := @spec.name;
+        ioFDirIndex := 0;
+
+        err := PBGetCatInfoSync(@paramBlock);
+
+        DoFindOne := MacOSErr2RTEerr(err);
+      end;
+  end;
+
+  {To be used after a call to DoFindOne, with the same spec and paramBlock.}
+  {Change those parameters in paramBlock, which is to be changed.}
+  function DoSetOne (var spec: FSSpec; var paramBlock: CInfoPBRec): Integer;
+
+    var
+      err: OSErr;
+
+  begin
+    with paramBlock do
+      begin
+        ioVRefNum := spec.vRefNum;
+        ioDirID := spec.parID;
+        ioNamePtr := @spec.name;
+
+        err := PBSetCatInfoSync(@paramBlock);
+
+        DoSetOne := MacOSErr2RTEerr(err);
+      end;
+  end;
+
+  procedure DoFind (var F: SearchRec; firstTime: Boolean);
+
+    var
+      err: OSErr;
+      s: Str255;
+
+  begin
+    with F, paramBlock do
+      begin
+        ioVRefNum := searchFSSpec.vRefNum;
+        if firstTime then
+          ioFDirIndex := 0;
+
+        while true do
+          begin
+            s := '';
+            ioDirID := searchFSSpec.parID;
+            ioFDirIndex := ioFDirIndex + 1;
+            ioNamePtr := @s;
+
+            err := PBGetCatInfoSync(@paramBlock);
+
+            if err <> noErr then
+              begin
+                if err = fnfErr then
+                  DosError := 18
+                else
+                  DosError := MacOSErr2RTEerr(err);
+                break;
+              end;
+
+            attr := GetFileAttrFromPB(f.paramBlock);
+            if ((Attr and not(searchAttr)) = 0) then
+              begin
+                name := s;
+                UpperString(s, true);
+
+                if FNMatch(F.searchFSSpec.name, s) then
+                  begin
+                    size := GetFileSizeFromPB(paramBlock);
+                    time := MacTimeToDosPackedTime(ioFlMdDat);
+                    DosError := 0;
+                    break;
+                  end;
+              end;
+          end;
+      end;
+  end;
+
+  procedure FindFirst (const path: pathstr; Attr: Word; var F: SearchRec);
+    var
+      s: Str255;
+
+  begin
+    fillchar(f, sizeof(f), 0);
+
+    if path = '' then
+      begin
+        DosError := 3;
+        Exit;
+      end;
+
+    {We always also search for readonly and archive, regardless of Attr.}
+    F.searchAttr := (Attr or (archive or readonly));
+
+    DosError := PathArgToFSSpec(path, F.searchFSSpec);
+    with F do
+      if (DosError = 0) or (DosError = 2) then
+        begin
+          SearchSpec := path;
+          NamePos := Length(path) - Length(searchFSSpec.name);
+
+          if (Pos('?', searchFSSpec.name) = 0) and (Pos('*', searchFSSpec.name) = 0) then  {No wildcards}
+            begin  {If exact match, we don't have to scan the directory}
+              exactMatch := true;
+              DosError := DoFindOne(searchFSSpec, paramBlock);
+              if DosError = 0 then
+                begin
+                  Attr := GetFileAttrFromPB(paramBlock);
+                  if ((Attr and not(searchAttr)) = 0) then
+                    begin
+                      name := searchFSSpec.name;
+                      size := GetFileSizeFromPB(paramBlock);
+                      time := MacTimeToDosPackedTime(paramBlock.ioFlMdDat);
+                    end
+                  else
+                    DosError := 18;
+                end
+              else if DosError = 2 then
+                DosError := 18;
+            end
+          else
+            begin
+              exactMatch := false;
+
+              s := searchFSSpec.name;
+              UpperString(s, true);
+              F.searchFSSpec.name := s;
+
+              DoFind(F, true);
+            end;
+        end;
+  end;
+
+  procedure FindNext (var f: searchRec);
+
+  begin
+    if F.exactMatch then
+      DosError := 18
+    else
+      DoFind(F, false);
+  end;
+
+  procedure FindClose (var f: searchRec);
+  {Note: Even if this routine is empty, this doesn't mean it will}
+  {be empty in the future. Please use it.}
+  begin
+  end;
+
+
+
+{******************************************************************************
+                               --- File ---
+******************************************************************************}
+
+  function FSearch (path: pathstr; dirlist: string): pathstr;
+      {Searches for a file 'path' in the working directory and then in the list of }
+      {directories in 'dirlist' . Returns a valid (possibly relative) path or an }
+      {empty string if not found . Wildcards are NOT allowed }
+      {The dirlist can be separated with ; or , but not :}
+
+    var
+      NewDir: string[255];
+      p1: Longint;
+      spec: FSSpec;
+      fpcerr: Integer;
+
+  begin
+    FSearch := '';
+    if (Length(path) = 0) then
+      Exit;
+
+    {Check for Wild Cards}
+    if (Pos('?', Path) <> 0) or (Pos('*', Path) <> 0) then
+      Exit;
+
+    path := TranslatePathToMac(path, false);
+
+    {Search in working directory, or as full path}
+    fpcerr := PathArgToFSSpec(path, spec);
+    if (fpcerr = 0) and not IsDirectory(spec) then
+      begin
+        FSearch := path;
+        Exit;
+      end
+    else if not IsMacFullPath(path) then    {If full path, we do not need to continue.}
+      begin
+        {Replace ';' with native mac PathSeparator (',').}
+        {Note: we cannot support unix style ':', because it is used as dir separator in MacOS}
+        for p1 := 1 to length(dirlist) do
+          if dirlist[p1] = ';' then
+            dirlist[p1] := PathSeparator;
+
+        repeat
+          p1 := Pos(PathSeparator, DirList);
+          if p1 = 0 then
+            p1 := 255;
+          NewDir := TranslatePathToMac(Copy(DirList, 1, P1 - 1), false);
+
+          NewDir := ConcatMacPath(NewDir, Path);
+
+          Delete(DirList, 1, p1);
+
+          fpcerr := PathArgToFSSpec(NewDir, spec);
+          if fpcerr = 0 then
+            begin
+              if IsDirectory(spec) then
+                NewDir := '';
+            end
+          else
+            NewDir := '';
+        until (DirList = '') or (Length(NewDir) > 0);
+        FSearch := NewDir;
+      end;
+  end;
+
+
+{$UNDEF USE_FEXPAND_INC}
+
+{$IFDEF USE_FEXPAND_INC}
+
+
+{$DEFINE FPC_FEXPAND_VOLUMES}
+{$DEFINE FPC_FEXPAND_NO_DEFAULT_PATHS}
+
+{ TODO A lot of issues before this works}
+
+{$I fexpand.inc}
+
+{$UNDEF FPC_FEXPAND_VOLUMES}
+{$UNDEF FPC_FEXPAND_NO_DEFAULT_PATHS}
+
+
+{$ELSE}
+
+{ TODO nonexisting dirs in path's doesnt work (nonexisting files do work)
+       example: Writeln('FExpand on :nisse:kalle : ', FExpand(':nisse:kalle')); }
+
+  function FExpand (const path: pathstr): pathstr;
+  var
+    fullpath: AnsiString;
+  begin
+    DosError:= PathArgToFullPath(path, fullpath);
+    FExpand:= fullpath;
+  end;
+
+{$ENDIF}
+
+  procedure FSplit (path: pathstr; var dir: dirstr; var name: namestr; var ext: extstr);
+
+  var
+    dotPos,colonPos,i : longint;
+  
+  begin
+    colonPos:=0;
+    dotPos:=256;
+    i:=Length(path);
+    while (i>0) and (colonPos=0) Do
+      begin
+        If (dotPos=256) and (path[i]='.') Then
+          dotPos:=i;
+        If (path[i]=':') Then
+          colonPos:=i;
+        Dec(i);
+      end;
+    ext:=Copy(path,dotPos,255);
+    dir:=Copy(path,1,colonPos);
+    name:=Copy(path,colonPos + 1,dotPos - colonPos - 1);
+  end;
+
+  procedure GetFTime (var f ; var time: longint);
+
+    var
+      spec: FSSpec;
+      paramBlock: CInfoPBRec;
+
+  begin
+    DosError := PathArgToFSSpec(filerec(f).name, spec);
+    if (DosError = 0) or (DosError = 2) then
+      begin
+        DosError := DoFindOne(spec, paramBlock);
+        if DosError = 0 then
+          time := MacTimeToDosPackedTime(paramBlock.ioFlMdDat);
+      end;
+  end;
+
+  procedure SetFTime (var f ; time: longint);
+
+    var
+      spec: FSSpec;
+      paramBlock: CInfoPBRec;
+      d: DateTimeRec; {Mac OS datastructure}
+      t: datetime; 
+      macfiletime: UInt32;
+
+  begin
+    DosError := PathArgToFSSpec(filerec(f).name, spec);
+    if (DosError = 0) or (DosError = 2) then
+      begin
+        DosError := DoFindOne(spec, paramBlock);
+        if DosError = 0 then
+          begin
+            Unpacktime(time, t);
+            with t do
+              begin
+                d.year := year;
+                d.month := month;
+                d.day := day;
+                d.hour := hour;
+                d.minute := min;
+                d.second := sec;
+              end;
+            DateToSeconds(d, macfiletime);
+            paramBlock.ioFlMdDat := macfiletime;
+            DosError := DoSetOne(spec, paramBlock);
+          end;
+      end;
+  end;
+
+  procedure GetFAttr (var f ; var attr: word);
+
+    var
+      spec: FSSpec;
+      paramBlock: CInfoPBRec;
+
+  begin
+    DosError := PathArgToFSSpec(filerec(f).name, spec);
+    if (DosError = 0) or (DosError = 2) then
+      begin
+        DosError := DoFindOne(spec, paramBlock);
+        if DosError = 0 then
+          attr := GetFileAttrFromPB(paramBlock);
+      end;
+  end;
+
+  procedure SetFAttr (var f ; attr: word);
+
+    var
+      spec: FSSpec;
+      paramBlock: CInfoPBRec;
+
+  begin
+    if (attr and VolumeID) <> 0 then
+      begin
+        Doserror := 5;
+      end;
+
+    DosError := PathArgToFSSpec(filerec(f).name, spec);
+    if (DosError = 0) or (DosError = 2) then
+      begin
+        DosError := DoFindOne(spec, paramBlock);
+        if DosError = 0 then
+          begin
+            SetPBFromFileAttr(paramBlock, attr);
+            DosError := DoSetOne(spec, paramBlock);
+
+            if (paramBlock.ioFlAttrib and $10) = 0 then    {check not directory}
+              if DosError = 0 then
+                if (attr and readonly) <> 0 then
+                  DosError := MacOSErr2RTEerr(FSpSetFLock(spec))
+                else
+                  DosError := MacOSErr2RTEerr(FSpRstFLock(spec));
+          end;
+      end;
+  end;
+
+{******************************************************************************
+                             --- Environment ---
+******************************************************************************}
+
+Function EnvCount: Longint;
+var
+  envcnt : longint;
+  p      : ppchar;
+Begin
+  envcnt:=0;
+  p:=envp;      {defined in system}
+  while (p^<>nil) do
+   begin
+     inc(envcnt);
+     inc(p);
+   end;
+  EnvCount := envcnt
+End;
+
+
+Function EnvStr (Index: longint): String;
+
+Var
+  i : longint;
+  p : ppchar;
+Begin
+  p:=envp;      {defined in system}
+  i:=1;
+  while (i<Index) and (p^<>nil) do
+    begin
+      inc(i);
+      inc(p);
+    end;
+  if p=nil then
+    envstr:=''
+  else
+    begin
+      envstr:=strpas(p^) + '=' + strpas(p^+strlen(p^)+1)
+    end;
+End;
+
+
+function c_getenv(varname: PChar): PChar; {TODO perhaps move to a separate inc file.}
+  external 'StdCLib' name 'getenv';
+
+Function GetEnv(EnvVar: String): String;
+var
+  p: PChar;
+  name: String;
+Begin
+  name:= EnvVar+#0;
+  p:= c_getenv(@name[1]);
+  if p=nil then
+   GetEnv:=''
+  else
+   GetEnv:=StrPas(p);
+End;
+
+{******************************************************************************
+                      --- Do Nothing Procedures/Functions ---
+******************************************************************************}
+
+Procedure getintvec(intno : byte;var vector : pointer);
+Begin
+  {! No MacOS equivalent !}
+End;
+
+Procedure setintvec(intno : byte;vector : pointer);
+Begin
+  {! No MacOS equivalent !}
+End;
+
+Procedure SwapVectors;
+Begin
+  {! No MacOS equivalent !}
+End;
+
+Procedure Keep(exitcode : word);
+Begin
+  {! No MacOS equivalent !}
+End;
+
+Procedure GetCBreak(Var BreakValue: Boolean);
+Begin
+  {! Might be implemented in future on MacOS to handle Cmd-. (period) key press}
+  breakvalue:=true
+End;
+
+Procedure SetCBreak(BreakValue: Boolean);
+Begin
+  {! Might be implemented in future on MacOS to handle Cmd-. (period) key press}
+End;
+
+Procedure GetVerify(Var Verify: Boolean);
+Begin
+  {! Might be implemented in future on MacOS}
+  Verify:=true;
+End;
+
+Procedure SetVerify(Verify: Boolean);
+Begin
+  {! Might be implemented in future on MacOS}
+End;
+
+function  GetShortName(var p : String) : boolean;
+
+begin
+  { short=long under MacOS}
+ GetShortName:=True;
+end;
+
+function  GetLongName(var p : String) : boolean;
+begin
+  { short=long under MacOS}
+ GetLongName:=True;
+end;
+
+{******************************************************************************
+                            --- Initialization ---
+******************************************************************************}
+
+End.