فهرست منبع

+ Implemented winsysut unit

michael 21 سال پیش
والد
کامیت
c7385cf2cb
4فایلهای تغییر یافته به همراه115 افزوده شده و 52 حذف شده
  1. 12 50
      rtl/win32/Makefile
  2. 4 1
      rtl/win32/Makefile.fpc
  3. 11 1
      rtl/win32/sysutils.pp
  4. 88 0
      rtl/win32/winsysut.pp

+ 12 - 50
rtl/win32/Makefile

@@ -1,8 +1,8 @@
 #
-# Don't edit, this file is generated by FPCMake Version 1.1 [2004/01/08]
+# Don't edit, this file is generated by FPCMake Version 1.1 [2003/09/24]
 #
 default: all
-MAKEFILETARGETS=linux go32v2 win32 os2 freebsd beos netbsd amiga atari sunos qnx netware openbsd wdosx palmos macos darwin emx watcom
+MAKEFILETARGETS=win32
 override PATH:=$(subst \,/,$(PATH))
 ifeq ($(findstring ;,$(PATH)),)
 inUnix=1
@@ -10,7 +10,6 @@ SEARCHPATH:=$(filter-out .,$(subst :, ,$(PATH)))
 else
 SEARCHPATH:=$(subst ;, ,$(PATH))
 endif
-SEARCHPATH+=$(patsubst %/,%,$(subst \,/,$(dir $(MAKE))))
 PWD:=$(strip $(wildcard $(addsuffix /pwd.exe,$(SEARCHPATH))))
 ifeq ($(PWD),)
 PWD:=$(strip $(wildcard $(addsuffix /pwd,$(SEARCHPATH))))
@@ -226,7 +225,7 @@ OBJPASDIR=$(RTL)/objpas
 GRAPHDIR=$(INC)/graph
 include $(WININC)/makefile.inc
 WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES)))
-override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas strings lineinfo heaptrc windows ole2 activex winsock initc dos crt objects graph messages sysutils classes typinfo math varutils variants cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer dynlibs video mouse keyboard types comobj dateutils rtlconst sysconst
+override TARGET_UNITS+=$(SYSTEMUNIT) systhrds objpas strings lineinfo heaptrc windows ole2 activex winsock initc dos crt objects graph messages sysutils classes typinfo math varutils variants cpu mmx charset ucomplex getopts wincrt winmouse winevent sockets printer dynlibs video mouse keyboard types comobj dateutils rtlconst sysconst winsysut
 override TARGET_LOADERS+=wprt0 wdllprt0 gprt0
 override TARGET_RSTS+=math varutils typinfo variants classes dateutils sysconst
 override INSTALL_FPCPACKAGE=y
@@ -315,17 +314,9 @@ endif
 endif
 ifndef INSTALL_BINDIR
 ifdef UNIXINSTALLDIR
-ifdef CROSSCOMPILE
-INSTALL_BINDIR:=$(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/bin
-else
 INSTALL_BINDIR:=$(INSTALL_PREFIX)/bin
-endif
-else
-ifdef CROSSCOMPILE
-INSTALL_BINDIR:=$(INSTALL_BASEDIR)/cross/$(FULL_TARGET)/bin
 else
 INSTALL_BINDIR:=$(INSTALL_BASEDIR)/bin
-endif
 ifdef INSTALL_FPCPACKAGE
 INSTALL_BINDIR:=$(INSTALL_BINDIR)/$(OS_TARGET)
 endif
@@ -457,14 +448,6 @@ STATICLIBPREFIX=
 FPCMADE=fpcmade.dos
 ZIPSUFFIX=go32
 endif
-ifeq ($(OS_TARGET),watcom)
-STATICLIBPREFIX=
-FPCMADE=fpcmade.wat
-ZIPSUFFIX=watc
-OEXT=.obj
-ASMEXT=.asm
-SHAREDLIBEXT=.dll
-endif
 ifeq ($(OS_TARGET),linux)
 EXEEXT=
 HASSHAREDLIB=1
@@ -567,11 +550,6 @@ STATICLIBPREFIX=
 FPCMADE=fpcmade.dos
 ZIPSUFFIX=go32
 endif
-ifeq ($(OS_TARGET),watcom)
-STATICLIBPREFIX=
-FPCMADE=fpcmade.dos
-ZIPSUFFIX=watcom
-endif
 ifeq ($(OS_TARGET),linux)
 EXEEXT=
 HASSHAREDLIB=1
@@ -760,11 +738,7 @@ endif
 endif
 export MVPROG
 ifndef ECHOREDIR
-ifndef inUnix
-ECHOREDIR=echo
-else
-ECHOREDIR=$(ECHO)
-endif
+ECHOREDIR:=$(subst /,$(PATHSEP),$(ECHO))
 endif
 ifndef COPY
 COPY:=$(CPPROG) -fp
@@ -835,16 +809,14 @@ TARPROG:=$(firstword $(TARPROG))
 endif
 endif
 export TARPROG
-ASNAME=$(BINUTILSPREFIX)as
-LDNAME=$(BINUTILSPREFIX)ld
-ARNAME=$(BINUTILSPREFIX)ar
-RCNAME=$(BINUTILSPREFIX)rc
-ifneq ($(findstring 1.0.,$(FPC_VERSION)),)
-ifeq ($(OS_TARGET),win32)
 ASNAME=as
 LDNAME=ld
 ARNAME=ar
-endif
+RCNAME=rc
+ifeq ($(OS_TARGET),win32)
+ASNAME=asw
+LDNAME=ldw
+ARNAME=arw
 endif
 ifndef ASPROG
 ifdef CROSSBINDIR
@@ -926,14 +898,6 @@ endif
 ifeq ($(OS_SOURCE),openbsd)
 override FPCOPT+=-FD$(NEW_BINUTILS_PATH)
 endif
-ifndef CROSSBOOTSTRAP
-ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-XP$(BINUTILSPREFIX) -Xc
-endif
-ifneq ($(BINUTILSPREFIX),)
-override FPCOPT+=-Xr$(RLINKPATH)
-endif
-endif
 ifdef UNITDIR
 override FPCOPT+=$(addprefix -Fu,$(UNITDIR))
 endif
@@ -1080,7 +1044,7 @@ fpc_debug:
 	$(MAKE) all DEBUG=1
 fpc_release:
 	$(MAKE) all RELEASE=1
-.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .dpr .pp .rc .res
+.SUFFIXES: $(EXEEXT) $(PPUEXT) $(OEXT) .pas .pp .rc .res
 %$(PPUEXT): %.pp
 	$(COMPILER) $<
 	$(EXECPPAS)
@@ -1093,14 +1057,10 @@ fpc_release:
 %$(EXEEXT): %.pas
 	$(COMPILER) $<
 	$(EXECPPAS)
-%$(EXEEXT): %.dpr
-	$(COMPILER) $<
-	$(EXECPPAS)
 %.res: %.rc
 	windres -i $< -o $@
 vpath %.pp $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %.pas $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
-vpath %.dpr $(COMPILER_SOURCEDIR) $(COMPILER_INCLUDEDIR)
 vpath %$(PPUEXT) $(COMPILER_UNITTARGETDIR)
 .PHONY: fpc_install fpc_sourceinstall fpc_exampleinstall
 ifdef INSTALL_UNITS
@@ -1387,6 +1347,8 @@ sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \
 classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
 		   sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) sysconst$(PPUEXT)
 	$(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
+winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT)
+	$(COMPILER) winsysut.pp
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
 	$(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
 math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT)

+ 4 - 1
rtl/win32/Makefile.fpc

@@ -14,7 +14,7 @@ units=$(SYSTEMUNIT) systhrds objpas strings \
       sysutils classes typinfo math varutils variants \
       cpu mmx charset ucomplex getopts \
       wincrt winmouse winevent sockets printer dynlibs \
-      video mouse keyboard types comobj dateutils rtlconst sysconst
+      video mouse keyboard types comobj dateutils rtlconst sysconst winsysut
 
 rsts=math varutils typinfo variants classes dateutils sysconst
 
@@ -181,6 +181,9 @@ classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \
                    sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconst$(PPUEXT) sysconst$(PPUEXT)
         $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp
 
+winsysut$(PPUEXT) : winsysut.pp sysutils$(PPUEXT)
+        $(COMPILER) winsysut.pp
+
 typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT)
         $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp
 

+ 11 - 1
rtl/win32/sysutils.pp

@@ -34,6 +34,7 @@ uses
   windows;
 
 {$DEFINE HAS_SLEEP}
+{$DEFINE HAS_OSERROR}
 
 { Include platform independent interface part }
 {$i sysutilh.inc}
@@ -732,6 +733,12 @@ begin
   Windows.Sleep(MilliSeconds)
 end;
 
+Function GetLastOSError : Integer;
+
+begin
+  Result:=GetLastError;
+end;
+
 {****************************************************************************
                               Initialization code
 ****************************************************************************}
@@ -793,7 +800,10 @@ Finalization
 end.
 {
   $Log$
-  Revision 1.31  2004-01-20 23:12:49  hajny
+  Revision 1.32  2004-02-08 11:00:18  michael
+  + Implemented winsysut unit
+
+  Revision 1.31  2004/01/20 23:12:49  hajny
     * ExecuteProcess fixes, ProcessID and ThreadID added
 
   Revision 1.30  2004/01/16 20:53:33  michael

+ 88 - 0
rtl/win32/winsysut.pp

@@ -0,0 +1,88 @@
+{
+    $Id$
+    This file is part of the Free Pascal run time library.
+    Copyright (c) 2003 by the Free Pascal development team
+
+    Windows specific versions of Borland SysUtils routines.
+    
+    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.
+
+ **********************************************************************}
+{$mode objfpc}
+unit winsysut;
+
+Interface
+
+Uses Windows,SysUtils;
+
+const  
+  Win32Platform     : Integer = 0;
+  Win32MajorVersion : Integer = 0;
+  Win32MinorVersion : Integer = 0;
+  Win32BuildNumber  : Integer = 0;
+                          
+  Win32CSDVersion   : string = '';
+ 
+function CheckWin32Version(Major,Minor : Integer ): Boolean;
+function CheckWin32Version(Major : Integer): Boolean;
+Function Win32Check(RetVal: BOOL): BOOL; 
+Procedure RaiseLastWin32Error; 
+
+Implementation
+
+procedure RaiseLastWin32Error;
+
+begin
+  RaiseLastOSError;
+end;
+
+Function Win32Check(RetVal: BOOL): BOOL; 
+
+begin
+  if Not RetVal then 
+    RaiseLastOSError;
+  Result := RetVal;
+end;
+
+procedure InitVersion;
+
+var
+  Info: TOSVersionInfo;
+  
+begin
+  Info.dwOSVersionInfoSize := SizeOf(Info);
+  if GetVersionEx(Info) then
+    with Info do
+      begin
+      Win32Platform:=dwPlatformId;
+      Win32MajorVersion:=dwMajorVersion;
+      Win32MinorVersion:=dwMinorVersion;
+      if (Win32Platform=VER_PLATFORM_WIN32_WINDOWS) then
+        Win32BuildNumber:=dwBuildNumber and $FFFF
+      else
+        Win32BuildNumber := dwBuildNumber;
+      Win32CSDVersion := StrPas(szCSDVersion);
+      end;
+end;
+
+function CheckWin32Version(Major : Integer): Boolean;
+
+begin
+  Result:=CheckWin32Version(Major,0)
+end;
+
+function CheckWin32Version(Major,Minor: Integer): Boolean;
+
+begin
+  Result := (Win32MajorVersion>Major) or
+            ((Win32MajorVersion=Major) and (Win32MinorVersion>=Minor));
+end;
+
+Initialization
+  InitVersion;
+end.