diff --git a/.gitattributes b/.gitattributes index 813e9ac2cd..5168ca7fbd 100644 --- a/.gitattributes +++ b/.gitattributes @@ -4206,10 +4206,14 @@ rtl/win64/system.pp svneol=native#text/plain rtl/wince/Makefile svneol=native#text/plain rtl/wince/Makefile.fpc svneol=native#text/plain rtl/wince/arm/wprt0.as svneol=native#text/plain +rtl/wince/classes.pp -text rtl/wince/dos.pp -text rtl/wince/i386/wprt0.as svneol=native#text/plain +rtl/wince/messages.pp -text rtl/wince/readme-winceapi-port -text rtl/wince/system.pp svneol=native#text/plain +rtl/wince/sysutils.pp -text +rtl/wince/tthread.inc -text rtl/wince/windows.pp -text rtl/wince/wininc/base.inc -text rtl/wince/wininc/defines.inc -text diff --git a/rtl/wince/Makefile b/rtl/wince/Makefile index eb862b0985..32f541954e 100644 --- a/rtl/wince/Makefile +++ b/rtl/wince/Makefile @@ -248,112 +248,112 @@ GRAPHDIR=$(INC)/graph include $(WININC)/makefile.inc WINDOWS_SOURCE_FILES=$(addprefix $(WININC)/,$(addsuffix .inc,$(WINDOWS_FILES))) ifeq ($(FULL_TARGET),i386-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-go32v2) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-win32) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-os2) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-beos) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-solaris) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-qnx) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-netware) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-openbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-wdosx) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-emx) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-watcom) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-netwlibc) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-wince) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),m68k-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),m68k-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),m68k-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),m68k-amiga) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),m68k-atari) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),m68k-openbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),m68k-palmos) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),powerpc-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),powerpc-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),powerpc-macos) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),powerpc-darwin) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),powerpc-morphos) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),sparc-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),sparc-netbsd) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),sparc-solaris) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),x86_64-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),x86_64-freebsd) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),x86_64-win64) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),arm-linux) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),arm-wince) -override TARGET_UNITS+=$(SYSTEMUNIT) objpas strings lineinfo windows dos rtlconsts sysconst +override TARGET_UNITS+=$(SYSTEMUNIT) ctypes objpas macpas strings lineinfo windows messages dos objects rtlconsts sysconst sysutils typinfo types classes strutils convutils charset getopts endif ifeq ($(FULL_TARGET),i386-linux) override TARGET_LOADERS+=wprt0 #wdllprt0 @@ -1902,11 +1902,34 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\ $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT) $(COMPILER) -I$(WININC) windows.pp +messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT) + $(COMPILER) -I$(WININC) messages.pp dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) windows$(PPUEXT) +objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT) +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ + objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT) + $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp +classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ + sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT) + $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp +typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) + $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp +math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) + $(COMPILER) $(OBJPASDIR)/math.pp +types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) + $(COMPILER) $(OBJPASDIR)/types.pp rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp $(COMPILER) $(OBJPASDIR)/rtlconsts.pp sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) $(COMPILER) $(OBJPASDIR)/sysconst.pp +dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp + $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp +convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp + $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp +strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp + $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp +macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT) + $(COMPILER) $(INC)/macpas.pp $(REDIR) cpu$(PPUEXT) : $(PROCINC)/cpu.pp $(SYSTEMUNIT)$(PPUEXT) mmx$(PPUEXT) : $(PROCINC)/mmx.pp cpu$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) getopts$(PPUEXT) : $(INC)/getopts.pp $(SYSTEMUNIT)$(PPUEXT) @@ -1916,3 +1939,4 @@ lineinfo$(PPUEXT) : $(INC)/lineinfo.pp $(SYSTEMUNIT)$(PPUEXT) charset$(PPUEXT) : $(INC)/charset.pp $(SYSTEMUNIT)$(PPUEXT) cmem$(PPUEXT) : $(INC)/cmem.pp $(SYSTEMUNIT)$(PPUEXT) ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) +ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT) diff --git a/rtl/wince/Makefile.fpc b/rtl/wince/Makefile.fpc index 15b8cc522f..8d3ef51d27 100644 --- a/rtl/wince/Makefile.fpc +++ b/rtl/wince/Makefile.fpc @@ -7,19 +7,20 @@ main=rtl [target] loaders= wprt0 #wdllprt0 -units=$(SYSTEMUNIT) objpas strings \ -# ctypes macpas +units=$(SYSTEMUNIT) ctypes objpas macpas strings \ lineinfo \ # heaptrc matrix \ - windows \ + windows messages \ # winsock initc cmem dynlibs signals \ - dos \ -# crt objects graph messages \ - rtlconsts sysconst \ -# sysutils \ -# math types \ -# strutils convutils dateutils varutils variants typinfo classes \ -# cpu mmx charset ucomplex getopts \ + dos objects \ +# crt graph \ + rtlconsts sysconst sysutils \ + typinfo types classes \ +# math dateutils + strutils convutils \ +# varutils variants \ + charset getopts +# cpu mmx ucomplex \ # wincrt winmouse winevent sockets printer \ # video mouse keyboard \ # winsysut @@ -118,8 +119,8 @@ strings$(PPUEXT) : $(INC)/strings.pp $(INC)/stringsi.inc\ windows$(PPUEXT) : windows.pp $(WINDOWS_SOURCE_FILES) $(SYSTEMUNIT)$(PPUEXT) $(COMPILER) -I$(WININC) windows.pp -#messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT) -# $(COMPILER) -I$(WININC) messages.pp +messages$(PPUEXT): messages.pp $(WININC)/messages.inc $(SYSTEMUNIT)$(PPUEXT) + $(COMPILER) -I$(WININC) messages.pp #opengl32$(PPUEXT) : opengl32.pp windows$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) @@ -144,7 +145,7 @@ dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(S #crt$(PPUEXT) : crt.pp $(INC)/textrec.inc $(SYSTEMUNIT)$(PPUEXT) objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) -#objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT) +objects$(PPUEXT) : $(INC)/objects.pp $(SYSTEMUNIT)$(PPUEXT) # # Graph @@ -162,22 +163,22 @@ dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(S # Delphi Compatible Units # -#sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ -# objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT) -# $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp +sysutils$(PPUEXT) : sysutils.pp $(wildcard $(OBJPASDIR)/sysutils/*.inc) \ + objpas$(PPUEXT) dos$(PPUEXT) windows$(PPUEXT) sysconst$(PPUEXT) + $(COMPILER) -Fi$(OBJPASDIR)/sysutils sysutils.pp -#classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ -# sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) sysconst$(PPUEXT) -# $(COMPILER) -Fi$(OBJPASDIR)/classes classes.pp +classes$(PPUEXT) : classes.pp $(wildcard $(OBJPASDIR)/classes/*.inc) \ + sysutils$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(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 +typinfo$(PPUEXT): $(OBJPASDIR)/typinfo.pp objpas$(PPUEXT) + $(COMPILER) -Sg $(OBJPASDIR)/typinfo.pp -#math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) -# $(COMPILER) $(OBJPASDIR)/math.pp +math$(PPUEXT): $(OBJPASDIR)/math.pp objpas$(PPUEXT) sysutils$(PPUEXT) + $(COMPILER) $(OBJPASDIR)/math.pp #varutils$(PPUEXT) : $(OBJPASDIR)/cvarutil.inc $(OBJPASDIR)/varutils.inc \ # $(OBJPASDIR)/varutilh.inc varutils.pp sysutils$(PPUEXT) @@ -186,8 +187,8 @@ dos$(PPUEXT) : dos.pp $(INC)/filerec.inc $(INC)/textrec.inc strings$(PPUEXT) $(S #variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) sysutils$(PPUEXT) sysconst$(PPUEXT) typinfo$(PPUEXT) rtlconsts$(PPUEXT) # $(COMPILER) -Fi$(INC) $(INC)/variants.pp -#types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) -# $(COMPILER) $(OBJPASDIR)/types.pp +types$(PPUEXT) : $(OBJPASDIR)/types.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) + $(COMPILER) $(OBJPASDIR)/types.pp rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp $(COMPILER) $(OBJPASDIR)/rtlconsts.pp @@ -195,21 +196,21 @@ rtlconsts$(PPUEXT) : objpas$(PPUEXT) $(OBJPASDIR)/rtlconsts.pp sysconst$(PPUEXT) : $(OBJPASDIR)/sysconst.pp objpas$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) $(COMPILER) $(OBJPASDIR)/sysconst.pp -#dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp -# $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp +dateutils$(PPUEXT) : $(OBJPASDIR)/dateutils.pp + $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/dateutils.pp -#convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp -# $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp +convutils$(PPUEXT) : $(OBJPASDIR)/convutils.pp + $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/convutils.pp -#strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp -# $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp +strutils$(PPUEXT) : $(OBJPASDIR)/strutils.pp + $(COMPILER) -I$(OBJPASDIR) $(OBJPASDIR)/strutils.pp # # Mac Pascal Model # -#macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT) -# $(COMPILER) $(INC)/macpas.pp $(REDIR) +macpas$(PPUEXT) : $(INC)/macpas.pp $(SYSTEMUNIT)$(PPUEXT) + $(COMPILER) $(INC)/macpas.pp $(REDIR) # # Other system-independent RTL Units @@ -238,6 +239,6 @@ ucomplex$(PPUEXT) : $(INC)/ucomplex.pp math$(PPUEXT) $(SYSTEMUNIT)$(PPUEXT) #callspec$(PPUEXT) : $(INC)/callspec.pp $(SYSTEMUNIT)$(PPUEXT) -#ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT) +ctypes$(PPUEXT) : $(INC)/ctypes.pp $(SYSTEMUNIT)$(PPUEXT) #variants$(PPUEXT) : $(INC)/variants.pp varutils$(PPUEXT) typinfo$(PPUEXT) diff --git a/rtl/wince/classes.pp b/rtl/wince/classes.pp new file mode 100644 index 0000000000..56c3d8bafd --- /dev/null +++ b/rtl/wince/classes.pp @@ -0,0 +1,47 @@ +{ + This file is part of the Free Component Library (FCL) + Copyright (c) 1998 by Michael Van Canneyt and Florian Klaempfl + + Classes unit for wince + + 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} + +{ determine the type of the resource/form file } +{$define Win16Res} + +unit Classes; + +interface + +uses + rtlconsts, + sysutils, + types, + typinfo, + windows; + +{$i classesh.inc} + +implementation + +uses + sysconst; + +{ OS - independent class implementations are in /inc directory. } +{$i classes.inc} + +initialization + CommonInit; + +finalization + CommonCleanup; +end. diff --git a/rtl/wince/dos.pp b/rtl/wince/dos.pp index c3074242ef..a7134c9eb3 100644 --- a/rtl/wince/dos.pp +++ b/rtl/wince/dos.pp @@ -33,15 +33,6 @@ Type {$i dosh.inc} -//Const - { allow EXEC to inherited handles from calling process, - needed for FPREDIR in ide/text - now set to true by default because - other OS also pass open handles to childs - finally reset to false after Florian's response PM } -// ExecInheritsHandles : Longbool = false; - - implementation {$DEFINE HAS_GETMSCOUNT} @@ -208,14 +199,19 @@ var i, len: LongInt; begin GetDriveName:=nil; + // Current drive is C: drive always + if drive = 0 then + drive:=2; if (drive < 3) or (drive > 26) then exit; if DriveNames[1] = nil then begin + // Drive C: is filesystem root always GetMem(DriveNames[1], 2*SizeOf(WideChar)); DriveNames[1][0]:='\'; DriveNames[1][1]:=#0; + // Other drives are found dinamically h:=FindFirstFile('\*', @fd); if h <> 0 then begin @@ -322,7 +318,7 @@ begin F.ExcludeAttr:=(not Attr) and ($1e); {hidden,sys,dir,volume} StringToPchar(f.name); - { FindFirstFile is a Win32 Call } + { FindFirstFile is a WinCE Call } F.W32FindData.dwFileAttributes:=DosToWinAttr(f.attr); AnsiToWideBuf(@f.Name, -1, buf, SizeOf(buf)); F.FindHandle:=FindFirstFile (buf, F.W32FindData); @@ -498,81 +494,6 @@ begin GetEnv:=''; //!!! fixme end; -{ - The environment is a block of zero terminated strings - terminated by a #0 -} -(* -function envcount : longint; -var - hp,p : pchar; - count : longint; -begin - p:=GetEnvironmentStrings; - hp:=p; - count:=0; - while hp^<>#0 do - begin - { next string entry} - hp:=hp+strlen(hp)+1; - inc(count); - end; - FreeEnvironmentStrings(p); - envcount:=count; -end; - - -Function EnvStr (Index: longint): string; -var - hp,p : pchar; - count,i : longint; -begin - { envcount takes some time in win32 } - count:=envcount; - - { range checking } - if (index<=0) or (index>count) then - begin - envstr:=''; - exit; - end; - p:=GetEnvironmentStrings; - hp:=p; - - { retrive the string with the given index } - for i:=2 to index do - hp:=hp+strlen(hp)+1; - - envstr:=strpas(hp); - FreeEnvironmentStrings(p); -end; - - -Function GetEnv(envvar: string): string; -var - s : string; - i : longint; - hp,p : pchar; -begin - getenv:=''; - p:=GetEnvironmentStrings; - hp:=p; - while hp^<>#0 do - begin - s:=strpas(hp); - i:=pos('=',s); - if upcase(copy(s,1,i-1))=upcase(envvar) then - begin - getenv:=copy(s,i+1,length(s)-i); - break; - end; - { next string entry} - hp:=hp+strlen(hp)+1; - end; - FreeEnvironmentStrings(p); -end; -*) - var oldexitproc : pointer; diff --git a/rtl/wince/messages.pp b/rtl/wince/messages.pp new file mode 100644 index 0000000000..bd1b7edeef --- /dev/null +++ b/rtl/wince/messages.pp @@ -0,0 +1,15 @@ +unit messages; + + +interface + + uses + windows; + +{$DEFINE read_interface} +{$DEFINE MESSAGESUNIT} +{$I messages.inc} + +implementation + +end. diff --git a/rtl/wince/system.pp b/rtl/wince/system.pp index e1a6569b9f..d4791bd62d 100644 --- a/rtl/wince/system.pp +++ b/rtl/wince/system.pp @@ -56,12 +56,11 @@ var { C compatible arguments } argc : longint; argv : ppchar; -{ Win32 Info } +{ WinCE Info } hprevinst, - HInstance, MainInstance, DLLreason,DLLparam:longint; - Win32StackTop : Dword; + WinCEStackTop : Dword; type TDLL_Process_Entry_Hook = function (dllparam : longint) : longbool; @@ -73,9 +72,6 @@ const Dll_Thread_Attach_Hook : TDLL_Entry_Hook = nil; Dll_Thread_Detach_Hook : TDLL_Entry_Hook = nil; -type - HMODULE = THandle; - { ANSI <-> Wide } function AnsiToWideBuf(AnsiBuf: PChar; AnsiBufLen: longint; WideBuf: PWideChar; WideBufLen: longint): longint; function WideToAnsiBuf(WideBuf: PWideChar; WideBufLen: longint; AnsiBuf: PChar; AnsiBufLen: longint): longint; @@ -157,6 +153,9 @@ function i64tod(i : int64) : double; compilerproc; implementation +var + SysInstance : Longint; + function MessageBox(w1:longint;l1,l2:PWideChar;w2:longint):longint; stdcall;external 'coredll' name 'MessageBoxW'; @@ -182,7 +181,7 @@ function WideCharToMultiByte(CodePage:UINT; dwFlags:DWORD; lpWideCharStr:PWideCh function AnsiToWideBuf(AnsiBuf: PChar; AnsiBufLen: longint; WideBuf: PWideChar; WideBufLen: longint): longint; begin - Result := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, AnsiBuf, AnsiBufLen, WideBuf, WideBufLen); + Result := MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, AnsiBuf, AnsiBufLen, WideBuf, WideBufLen div SizeOf(WideChar)); if ((AnsiBufLen <> -1) or (Result = 0)) and (WideBuf <> nil) then begin if (Result + 1)*SizeOf(WideChar) > WideBufLen then @@ -192,7 +191,10 @@ begin exit; end; WideBuf[Result] := #0; + if (Result <> 0) or (AnsiBufLen = 0) then + Inc(Result); end; + Result:=Result*SizeOf(WideChar); end; function WideToAnsiBuf(WideBuf: PWideChar; WideBufLen: longint; AnsiBuf: PChar; AnsiBufLen: longint): longint; @@ -207,6 +209,8 @@ begin exit; end; AnsiBuf[Result] := #0; + if (Result <> 0) or (WideBufLen = 0) then + Inc(Result); end; end; @@ -405,7 +409,7 @@ var begin { create commandline, it starts with the executed filename which is argv[0] } - { Win32 passes the command NOT via the args, but via getmodulefilename} + { WinCE passes the command NOT via the args, but via getmodulefilename} argv:=nil; argvlen:=0; pc:=getcommandfile; @@ -427,7 +431,7 @@ begin count:=0; pc:=cmdline; {$IfDef SYSTEM_DEBUG_STARTUP} - Writeln(stderr,'Win32 GetCommandLine is #',pc,'#'); + Writeln(stderr,'WinCE GetCommandLine is #',pc,'#'); {$EndIf } while pc^<>#0 do begin @@ -701,7 +705,7 @@ end; // { - Error code definitions for the Win32 API functions + Error code definitions for the WinCE API functions Values are 32 bit values layed out as follows: @@ -1198,7 +1202,8 @@ begin res := 215; STATUS_ILLEGAL_INSTRUCTION: res := 216; - STATUS_ACCESS_VIOLATION: + STATUS_ACCESS_VIOLATION, + STATUS_DATATYPE_MISALIGNMENT: res := 216; STATUS_CONTROL_C_EXIT: res := 217; @@ -1258,7 +1263,7 @@ begin pushl %ebp xorl %ebp,%ebp movl %esp,%eax - movl %eax,Win32StackTop + movl %eax,WinCEStackTop movw %ss,%bp movl %ebp,_SS call SysResetFPU @@ -1283,7 +1288,45 @@ function CharUpperBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external Ke function CharLowerBuff(lpsz:LPWSTR; cchLength:DWORD):DWORD; stdcall; external KernelDLL name 'CharLowerBuffW'; -function Win32WideUpper(const s : WideString) : WideString; +procedure WinCEWide2AnsiMove(source:pwidechar;var dest:ansistring;len:SizeInt); + var + i: integer; + begin + if len = 0 then + dest:='' + else + begin + for i:=1 to 2 do begin + setlength(dest, len); + len:=WideCharToMultiByte(CP_ACP, 0, source, len, @dest[1], len, nil, nil); + if len > 0 then + break; + len:=WideCharToMultiByte(CP_ACP, 0, source, len, nil, 0, nil, nil); + end; + setlength(dest, len); + end; + end; + +procedure WinCEAnsi2WideMove(source:pchar;var dest:widestring;len:SizeInt); + var + i: integer; + begin + if len = 0 then + dest:='' + else + begin + for i:=1 to 2 do begin + setlength(dest, len); + len:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, @dest[1], len); + if len > 0 then + break; + len:=MultiByteToWideChar(CP_ACP, MB_PRECOMPOSED, source, len, nil, 0); + end; + setlength(dest, len); + end; + end; + +function WinCEWideUpper(const s : WideString) : WideString; begin result:=s; UniqueString(result); @@ -1292,7 +1335,7 @@ function Win32WideUpper(const s : WideString) : WideString; end; -function Win32WideLower(const s : WideString) : WideString; +function WinCEWideLower(const s : WideString) : WideString; begin result:=s; UniqueString(result); @@ -1303,10 +1346,12 @@ function Win32WideLower(const s : WideString) : WideString; { there is a similiar procedure in sysutils which inits the fields which are only relevant for the sysutils units } -procedure InitWin32Widestrings; +procedure InitWinCEWidestrings; begin - widestringmanager.UpperWideStringProc:=@Win32WideUpper; - widestringmanager.LowerWideStringProc:=@Win32WideLower; + widestringmanager.Wide2AnsiMoveProc:=@WinCEWide2AnsiMove; + widestringmanager.Ansi2WideMoveProc:=@WinCEAnsi2WideMove; + widestringmanager.UpperWideStringProc:=@WinCEWideUpper; + widestringmanager.LowerWideStringProc:=@WinCEWideLower; end; @@ -1434,7 +1479,7 @@ var buf: array[0..MaxPathLen] of WideChar; begin GetModuleFileName(0, @buf, SizeOf(buf)); - HInstance:=GetModuleHandle(@buf); + SysInstance:=GetModuleHandle(@buf); end; const @@ -1464,5 +1509,5 @@ begin errno:=0; initvariantmanager; initwidestringmanager; - InitWin32Widestrings + InitWinCEWidestrings end. diff --git a/rtl/wince/sysutils.pp b/rtl/wince/sysutils.pp new file mode 100644 index 0000000000..2c1bc5fc7e --- /dev/null +++ b/rtl/wince/sysutils.pp @@ -0,0 +1,1039 @@ +{ + + This file is part of the Free Pascal run time library. + Copyright (c) 1999-2005 by Florian Klaempfl and Yury Sidorov + members of the Free Pascal development team + + Sysutils unit for wince + + 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 sysutils; +interface + +{$MODE objfpc} +{ force ansistrings } +{$H+} + +uses + dos, + windows; + +{$DEFINE HAS_SLEEP} +{$DEFINE HAS_OSERROR} +{$DEFINE HAS_OSCONFIG} + +{ Include platform independent interface part } +{$i sysutilh.inc} + +type + EWinCEError = class(Exception) + public + ErrorCode : DWORD; + end; + + +Var + WinCEPlatform : Longint; + WinCEMajorVersion, + WinCEMinorVersion, + WinCEBuildNumber : dword; + WinCECSDVersion : ShortString; // CSD record is 128 bytes only? + + +implementation + + uses + sysconst; + +{$DEFINE FPC_NOGENERICANSIROUTINES} +{$define HASEXPANDUNCFILENAME} + +{ Include platform independent implementation part } +{$i sysutils.inc} + +function PCharToPWideChar(str: PChar; strlen: longint = -1; outlen: PLongInt = nil): PWideChar; +var + len: longint; +begin + while True do begin + if strlen <> -1 then + len:=(strlen + 1) + else + len:=AnsiToWideBuf(str, -1, nil, 0); + if len > 0 then + begin + len:=len*SizeOf(WideChar); + GetMem(Result, len); + if (AnsiToWideBuf(str, -1, Result, len) = 0) and (strlen <> -1) then + begin + strlen:=-1; + continue; + end; + end + else begin + GetMem(Result, SizeOf(WideChar)); + Inc(len); + Result^:=#0; + end; + break; + end; + if outlen <> nil then + outlen^:=(len - 1)*SizeOf(WideChar); +end; + +function StringToPWideChar(const s: string; outlen: PLongInt = nil): PWideChar; +var + len, wlen: longint; +begin + len:=Length(s); + wlen:=(len + 1)*SizeOf(WideChar); + GetMem(Result, wlen); + wlen:=AnsiToWideBuf(PChar(s), len, Result, wlen); + if wlen = 0 then + begin + wlen:=AnsiToWideBuf(PChar(s), len, nil, 0); + if wlen > 0 then + begin + ReAllocMem(Result, wlen); + wlen:=AnsiToWideBuf(PChar(s), len, Result, wlen); + end + else + begin + Result^:=#0; + wlen:=SizeOf(WideChar); + end; + end; + if outlen <> nil then + outlen^:=(wlen - 1) div SizeOf(WideChar); +end; + +procedure PWideCharToString(const str: PWideChar; var Result: string; strlen: longint = -1); +var + len: longint; +begin + if str^ = #0 then + Result:='' + else + begin + while True do begin + if strlen <> -1 then + len:=(strlen + 1) div SizeOf(WideChar) + else + len:=WideToAnsiBuf(str, -1, nil, 0); + if len > 0 then + begin + SetLength(Result, len - 1); + if (WideToAnsiBuf(str, -1, @Result[1], len) = 0) and (strlen <> -1) then + begin + strlen:=-1; + continue; + end; + end + else + Result:=''; + break; + end; + end; +end; + +function ExpandUNCFileName (const filename:string) : string; +{ returns empty string on errors } +var + s : widestring; + size : dword; + rc : dword; + p,buf : pwidechar; +begin + s := ExpandFileName (filename); + + size := max_path*SizeOf(WideChar); + getmem(buf,size); + + try + rc := WNetGetUniversalName (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size); + + if rc=ERROR_MORE_DATA then + begin + buf:=reallocmem(buf,size); + rc := WNetGetUniversalName (pwidechar(s), UNIVERSAL_NAME_INFO_LEVEL, buf, @size); + end; + if rc = NO_ERROR then + Result := PRemoteNameInfo(buf)^.lpUniversalName + else if rc = ERROR_NOT_CONNECTED then + Result := filename + else + Result := ''; + finally + freemem(buf); + end; +end; + +{**************************************************************************** + File Functions +****************************************************************************} + +Function FileOpen (Const FileName : string; Mode : Integer) : Longint; +const + AccessMode: array[0..2] of Cardinal = ( + GENERIC_READ, + GENERIC_WRITE, + GENERIC_READ or GENERIC_WRITE); + ShareMode: array[0..4] of Integer = ( + 0, + 0, + FILE_SHARE_READ, + FILE_SHARE_WRITE, + FILE_SHARE_READ or FILE_SHARE_WRITE); +var + fn: PWideChar; +begin + fn:=StringToPWideChar(FileName); + result := CreateFile(fn, dword(AccessMode[Mode and 3]), + dword(ShareMode[(Mode and $F0) shr 4]), nil, OPEN_EXISTING, + FILE_ATTRIBUTE_NORMAL, 0); + FreeMem(fn); +end; + + +Function FileCreate (Const FileName : String) : Longint; +var + fn: PWideChar; +begin + fn:=StringToPWideChar(FileName); + Result := CreateFile(fn, GENERIC_READ or GENERIC_WRITE, + 0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0); + FreeMem(fn); +end; + + +Function FileCreate (Const FileName : String; Mode:longint) : SizeInt; +begin + FileCreate:=FileCreate(FileName); +end; + + +Function FileRead (Handle : Longint; Var Buffer; Count : longint) : Longint; +Var + res : dword; +begin + if ReadFile(Handle, Buffer, Count, res, nil) then + FileRead:=Res + else + FileRead:=-1; +end; + + +Function FileWrite (Handle : Longint; const Buffer; Count : Longint) : Longint; +Var + Res : dword; +begin + if WriteFile(Handle, Buffer, Count, Res, nil) then + FileWrite:=Res + else + FileWrite:=-1; +end; + + +Function FileSeek (Handle,FOffset,Origin : Longint) : Longint; +begin + Result := longint(SetFilePointer(Handle, FOffset, nil, Origin)); +end; + + +Function FileSeek (Handle : Longint; FOffset,Origin : Int64) : Int64; +begin + {$warning need to add 64bit call } + Result := longint(SetFilePointer(Handle, longint(FOffset), nil, longint(Origin))); +end; + + +Procedure FileClose (Handle : Longint); +begin + if Handle<=4 then + exit; + CloseHandle(Handle); +end; + + +Function FileTruncate (Handle,Size: Longint) : boolean; +begin + Result:=longint(SetFilePointer(handle,Size,nil,FILE_BEGIN))<>-1; + If Result then + Result:=SetEndOfFile(handle); +end; + + +Function DosToWinTime (DTime:longint;Var Wtime : TFileTime):longbool; +begin + DosToWinTime:=False; //!!! fixme +end; + + +Function WinToDosTime (Const Wtime : TFileTime;var DTime:longint):longbool; +begin + WinToDosTime:=False; //!!! fixme +end; + + +Function FileAge (Const FileName : String): Longint; +var + Handle: THandle; + FindData: TWin32FindData; + fn: PWideChar; +begin + fn:=StringToPWideChar(FileName); + Handle := FindFirstFile(fn, FindData); + FreeMem(fn); + if Handle <> INVALID_HANDLE_VALUE then + begin + Windows.FindClose(Handle); + if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then + If WinToDosTime(FindData.ftLastWriteTime,Result) then + exit; + end; + Result := -1; +end; + + +Function FileExists (Const FileName : String) : Boolean; +var + Handle: THandle; + FindData: TWin32FindData; + fn: PWideChar; +begin + fn:=StringToPWideChar(FileName); + Handle := FindFirstFile(PWideChar(widestring(FileName)), FindData); + FreeMem(fn); + Result:=Handle <> INVALID_HANDLE_VALUE; + If Result then + Windows.FindClose(Handle); +end; + + +Function DirectoryExists (Const Directory : String) : Boolean; +var + Handle: THandle; + FindData: TWin32FindData; + fn: PWideChar; +begin + fn:=StringToPWideChar(Directory); + Result:=False; + Handle := FindFirstFile(PWideChar(widestring(Directory)), FindData); + FreeMem(fn); + If (Handle <> INVALID_HANDLE_VALUE) then + begin + Result:=((FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = FILE_ATTRIBUTE_DIRECTORY); + Windows.FindClose(Handle); + end; +end; + + +Function FindMatch(var f: TSearchRec) : Longint; +begin + { Find file with correct attribute } + While (F.FindData.dwFileAttributes and cardinal(F.ExcludeAttr))<>0 do + begin + if not FindNextFile (F.FindHandle,F.FindData) then + begin + Result:=GetLastError; + exit; + end; + end; + { Convert some attributes back } + WinToDosTime(F.FindData.ftLastWriteTime,F.Time); + f.size:=F.FindData.NFileSizeLow; + f.attr:=F.FindData.dwFileAttributes; + PWideCharToString(@F.FindData.cFileName, f.Name); + Result:=0; +end; + + +Function FindFirst (Const Path : String; Attr : Longint; out Rslt : TSearchRec) : Longint; +var + fn: PWideChar; +begin + fn:=StringToPWideChar(Path); + Rslt.Name:=Path; + Rslt.Attr:=attr; + Rslt.ExcludeAttr:=(not Attr) and ($1e); + { $1e = faHidden or faSysFile or faVolumeID or faDirectory } + { FindFirstFile is a WinCE Call } + Rslt.FindHandle:=FindFirstFile (fn, Rslt.FindData); + FreeMem(fn); + If Rslt.FindHandle=Invalid_Handle_value then + begin + Result:=GetLastError; + exit; + end; + { Find file with correct attribute } + Result:=FindMatch(Rslt); +end; + + +Function FindNext (Var Rslt : TSearchRec) : Longint; +begin + if FindNextFile(Rslt.FindHandle, Rslt.FindData) then + Result := FindMatch(Rslt) + else + Result := GetLastError; +end; + + +Procedure FindClose (Var F : TSearchrec); +begin + if F.FindHandle <> INVALID_HANDLE_VALUE then + Windows.FindClose(F.FindHandle); +end; + + +Function FileGetDate (Handle : Longint) : Longint; +Var + FT : TFileTime; +begin + If GetFileTime(Handle,nil,nil,@ft) and + WinToDosTime(FT,Result) then + exit; + Result:=-1; +end; + + +Function FileSetDate (Handle,Age : Longint) : Longint; +Var + FT: TFileTime; +begin + Result := 0; + if DosToWinTime(Age,FT) and + SetFileTime(Handle, ft, ft, FT) then + Exit; + Result := GetLastError; +end; + + +Function FileGetAttr (Const FileName : String) : Longint; +var + fn: PWideChar; +begin + fn:=StringToPWideChar(FileName); + Result:=GetFileAttributes(fn); + FreeMem(fn); +end; + + +Function FileSetAttr (Const Filename : String; Attr: longint) : Longint; +var + fn: PWideChar; +begin + fn:=StringToPWideChar(FileName); + if not SetFileAttributes(fn, Attr) then + Result := GetLastError + else + Result:=0; + FreeMem(fn); +end; + + +Function DeleteFile (Const FileName : String) : Boolean; +var + fn: PWideChar; +begin + fn:=StringToPWideChar(FileName); + DeleteFile:=Windows.DeleteFile(fn); + FreeMem(fn); +end; + + +Function RenameFile (Const OldName, NewName : String) : Boolean; +var + fold, fnew: PWideChar; +begin + fold:=StringToPWideChar(OldName); + fnew:=StringToPWideChar(NewName); + Result := MoveFile(fold, fnew); + FreeMem(fnew); + FreeMem(fold); +end; + + +{**************************************************************************** + Disk Functions +****************************************************************************} + +function diskfree(drive : byte) : int64; +begin + Result := Dos.diskfree(drive); +end; + + +function disksize(drive : byte) : int64; +begin + Result := Dos.disksize(drive); +end; + + +Function GetCurrentDir : String; +begin + GetDir(0, result); +end; + + +Function SetCurrentDir (Const NewDir : String) : Boolean; +begin + {$I-} + ChDir(NewDir); + {$I+} + result := (IOResult = 0); +end; + + +Function CreateDir (Const NewDir : String) : Boolean; +begin + {$I-} + MkDir(NewDir); + {$I+} + result := (IOResult = 0); +end; + + +Function RemoveDir (Const Dir : String) : Boolean; +begin + {$I-} + RmDir(Dir); + {$I+} + result := (IOResult = 0); +end; + + +{**************************************************************************** + Time Functions +****************************************************************************} + + +Procedure GetLocalTime(var SystemTime: TSystemTime); +Var + Syst : Windows.TSystemtime; +begin + windows.Getlocaltime(@syst); + SystemTime.year:=syst.wYear; + SystemTime.month:=syst.wMonth; + SystemTime.day:=syst.wDay; + SystemTime.hour:=syst.wHour; + SystemTime.minute:=syst.wMinute; + SystemTime.second:=syst.wSecond; + SystemTime.millisecond:=syst.wMilliSeconds; +end; + + +{**************************************************************************** + Misc Functions +****************************************************************************} + +procedure Beep; +begin + MessageBeep(0); +end; + + +{**************************************************************************** + Locale Functions +****************************************************************************} + +Procedure InitAnsi; +Var + i : longint; +begin + { Fill table entries 0 to 127 } + for i := 0 to 96 do + UpperCaseTable[i] := chr(i); + for i := 97 to 122 do + UpperCaseTable[i] := chr(i - 32); + for i := 123 to 191 do + UpperCaseTable[i] := chr(i); + Move (CPISO88591UCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); + + for i := 0 to 64 do + LowerCaseTable[i] := chr(i); + for i := 65 to 90 do + LowerCaseTable[i] := chr(i + 32); + for i := 91 to 191 do + LowerCaseTable[i] := chr(i); + Move (CPISO88591LCT,UpperCaseTable[192],SizeOf(CPISO88591UCT)); +end; + + +function GetLocaleStr(LID, LT: Longint; const Def: string): ShortString; +var + L: Integer; + Buf: array[0..255] of WideChar; + s: widestring; +begin + L := GetLocaleInfo(LID, LT, Buf, SizeOf(Buf) div SizeOf(WideChar)); + if L > 0 then + begin + SetString(s, Buf, L - 1); + Result:=s; + end + else + Result := Def; +end; + + +function GetLocaleChar(LID, LT: Longint; Def: Char): Char; +var + Buf: array[0..1] of WideChar; + Buf2: array[0..1] of Char; +begin + if GetLocaleInfo(LID, LT, Buf, 2) > 0 then + begin + WideToAnsiBuf(Buf, -1, Buf2, SizeOf(Buf2)); + Result := Buf2[0]; + end + else + Result := Def; +end; + + +Function GetLocaleInt(LID,TP,Def: LongInt): LongInt; +Var + S: String; + C: Integer; +Begin + S:=GetLocaleStr(LID,TP,'0'); + Val(S,Result,C); + If C<>0 Then + Result:=Def; +End; + + +procedure GetFormatSettings; +var + HF : Shortstring; + LID : LCID; + I,Day,DateOrder : longint; +begin + LID := GetUserDefaultLCID; + { Date stuff } + for I := 1 to 12 do + begin + ShortMonthNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVMONTHNAME1+I-1,ShortMonthNames[i]); + LongMonthNames[I]:=GetLocaleStr(LID,LOCALE_SMONTHNAME1+I-1,LongMonthNames[i]); + end; + for I := 1 to 7 do + begin + Day := (I + 5) mod 7; + ShortDayNames[I]:=GetLocaleStr(LID,LOCALE_SABBREVDAYNAME1+Day,ShortDayNames[i]); + LongDayNames[I]:=GetLocaleStr(LID,LOCALE_SDAYNAME1+Day,LongDayNames[i]); + end; + DateSeparator := GetLocaleChar(LID, LOCALE_SDATE, '/'); + DateOrder := GetLocaleInt(LID, LOCALE_IDate, 0); + Case DateOrder Of + 1: Begin + ShortDateFormat := 'dd/mm/yyyy'; + LongDateFormat := 'dddd, d. mmmm yyyy'; + End; + 2: Begin + ShortDateFormat := 'yyyy/mm/dd'; + LongDateFormat := 'dddd, yyyy mmmm d.'; + End; + else + // Default american settings... + ShortDateFormat := 'mm/dd/yyyy'; + LongDateFormat := 'dddd, mmmm d. yyyy'; + End; + { Time stuff } + TimeSeparator := GetLocaleChar(LID, LOCALE_STIME, ':'); + TimeAMString := GetLocaleStr(LID, LOCALE_S1159, 'AM'); + TimePMString := GetLocaleStr(LID, LOCALE_S2359, 'PM'); + if StrToIntDef(GetLocaleStr(LID, LOCALE_ITLZERO, '0'), 0) = 0 then + HF:='h' + else + HF:='hh'; + // No support for 12 hour stuff at the moment... + ShortTimeFormat := HF+':nn'; + LongTimeFormat := HF + ':nn:ss'; + { Currency stuff } + CurrencyString:=GetLocaleStr(LID, LOCALE_SCURRENCY, ''); + CurrencyFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRENCY, '0'), 0); + NegCurrFormat:=StrToIntDef(GetLocaleStr(LID, LOCALE_INEGCURR, '0'), 0); + { Number stuff } + ThousandSeparator:=GetLocaleChar(LID, LOCALE_STHOUSAND, ','); + DecimalSeparator:=GetLocaleChar(LID, LOCALE_SDECIMAL, '.'); + CurrencyDecimals:=StrToIntDef(GetLocaleStr(LID, LOCALE_ICURRDIGITS, '0'), 0); +end; + + +Procedure InitInternational; +begin + InitInternationalGeneric; + SysLocale.MBCS:=GetSystemMetrics(SM_DBCSENABLED)<>0; + SysLocale.RightToLeft:=GetSystemMetrics(SM_MIDEASTENABLED)<>0; + InitAnsi; + GetFormatSettings; +end; + + +{**************************************************************************** + Target Dependent +****************************************************************************} + +function SysErrorMessage(ErrorCode: Integer): String; +var + MsgBuffer: PWideChar; + len: longint; +begin + len:=FormatMessage( + FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_IGNORE_INSERTS, + nil, + ErrorCode, + 0, + @MsgBuffer, { This function allocs the memory } + 0, + nil); + while (len > 0) and (MsgBuffer[len - 1] <= #32) do + Dec(len); + MsgBuffer[len]:=#0; + PWideCharToString(PWideChar(MsgBuffer), Result); + LocalFree(HLOCAL(MsgBuffer)); +end; + +{**************************************************************************** + Initialization code +****************************************************************************} + +// WinCE does not have environment. It can be emulated via registry or file. (YS) + +Function GetEnvironmentVariable(Const EnvVar : String) : String; +begin + Result := ''; //!!! fixme +end; + +Function GetEnvironmentVariableCount : Integer; +begin + Result := 0; //!!! fixme +end; + +Function GetEnvironmentString(Index : Integer) : String; +begin + Result := ''; //!!! fixme +end; + + +function ExecuteProcess(Const Path: AnsiString; Const ComLine: AnsiString):integer; +var + PI: TProcessInformation; + Proc : THandle; + l : DWord; + e : EOSError; + +begin + DosError := 0; + if not CreateProcess(PWideChar(widestring(Path)), PWideChar(widestring(ComLine)), + nil, nil, FALSE, 0, nil, nil, nil, PI) then + begin + e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,GetLastError]); + e.ErrorCode:=GetLastError; + raise e; + end; + Proc:=PI.hProcess; + CloseHandle(PI.hThread); + if WaitForSingleObject(Proc, dword($ffffffff)) <> $ffffffff then + begin + GetExitCodeProcess(Proc,l); + CloseHandle(Proc); + result:=l; + end + else + begin + e:=EOSError.CreateFmt(SExecuteProcessFailed,[Path,GetLastError]); + e.ErrorCode:=GetLastError; + CloseHandle(Proc); + raise e; + end; +end; + +function ExecuteProcess(Const Path: AnsiString; Const ComLine: Array of AnsiString):integer; + +Var + CommandLine : AnsiString; + i : Integer; + +Begin + Commandline:=''; + For i:=0 to high(ComLine) Do + Commandline:=CommandLine+' '+Comline[i]; + ExecuteProcess:=ExecuteProcess(Path,CommandLine); +End; + +Procedure Sleep(Milliseconds : Cardinal); + +begin + Windows.Sleep(MilliSeconds) +end; + +Function GetLastOSError : Integer; + +begin + Result:=GetLastError; +end; + +{**************************************************************************** + Initialization code +****************************************************************************} + +Procedure LoadVersionInfo; +Var + versioninfo : TOSVERSIONINFO; + i : Integer; + +begin + versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo); + GetVersionEx(versioninfo); + WinCEPlatform:=versionInfo.dwPlatformId; + WinCEMajorVersion:=versionInfo.dwMajorVersion; + WinCEMinorVersion:=versionInfo.dwMinorVersion; + WinCEBuildNumber:=versionInfo.dwBuildNumber; + i:=WideToAnsiBuf(@versioninfo.szCSDVersion, -1, @WinCECSDVersion[1], SizeOf(WinCECSDVersion) - 1); + if i <> 0 then + WinCECSDVersion[0]:=chr(i - 1); +end; + +Function GetSpecialDir(ID: Integer) : String; + +Var + APath : array[0..MAX_PATH] of WideChar; +begin + if SHGetSpecialFolderPath(0, APath, ID, True) then + begin + PWideCharToString(APath, Result); + Result:=IncludeTrailingPathDelimiter(Result); + end + else + Result:=''; +end; + +Function GetAppConfigDir(Global : Boolean) : String; + +begin + If Global then + Result:=DGetAppConfigDir(Global) // or use windows dir ?? + else + begin + Result:=GetSpecialDir(CSIDL_APPDATA)+ApplicationName; + If (Result='') then + Result:=DGetAppConfigDir(Global); + end; +end; + +Function GetAppConfigFile(Global : Boolean; SubDir : Boolean) : String; + +begin + if Global then + begin + Result:=IncludeTrailingPathDelimiter(DGetAppConfigDir(Global)); + if SubDir then + Result:=IncludeTrailingPathDelimiter(Result+'Config'); + Result:=Result+ApplicationName+ConfigExtension; + end + else + begin + Result:=IncludeTrailingPathDelimiter(GetAppConfigDir(False)); + if SubDir then + Result:=Result+'Config\'; + Result:=Result+ApplicationName+ConfigExtension; + end; +end; + +{**************************************************************************** + Target Dependent WideString stuff +****************************************************************************} + + +function WinCECompareWideString(const s1, s2 : WideString) : PtrInt; +begin + SetLastError(0); + Result:=CompareString(LOCALE_USER_DEFAULT,0,pwidechar(s1), + length(s1),pwidechar(s2),length(s2))-2; + if GetLastError<>0 then + RaiseLastOSError; +end; + + +function WinCECompareTextWideString(const s1, s2 : WideString) : PtrInt; +begin + SetLastError(0); + Result:=CompareString(LOCALE_USER_DEFAULT,NORM_IGNORECASE,pwidechar(s1), + length(s1),pwidechar(s2),length(s2))-2; + if GetLastError<>0 then + RaiseLastOSError; +end; + + +function WinCEAnsiUpperCase(const s: string): string; +var + buf: PWideChar; + len: longint; +begin + if s <> '' then + begin + buf:=StringToPWideChar(s, @len); + CharUpperBuff(buf, len); + PWideCharToString(buf, Result, len); + FreeMem(buf); + end + else + Result:=''; +end; + + +function WinCEAnsiLowerCase(const s: string): string; +var + buf: PWideChar; + len: longint; +begin + if s <> '' then + begin + buf:=StringToPWideChar(s, @len); + CharLowerBuff(buf, len); + PWideCharToString(buf, Result, len); + FreeMem(buf); + end + else + Result:=''; +end; + + +function WinCEAnsiCompareStr(const S1, S2: string): PtrInt; +var + ws1, ws2: PWideChar; +begin + ws1:=StringToPWideChar(S1); + ws2:=StringToPWideChar(S2); + Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, -1, ws2, -1) - 2; + FreeMem(ws2); + FreeMem(ws1); +end; + + +function WinCEAnsiCompareText(const S1, S2: string): PtrInt; +var + ws1, ws2: PWideChar; +begin + ws1:=StringToPWideChar(S1); + ws2:=StringToPWideChar(S2); + Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, -1, ws2, -1) - 2; + FreeMem(ws2); + FreeMem(ws1); +end; + +function WinCEAnsiStrComp(S1, S2: PChar): PtrInt; +var + ws1, ws2: PWideChar; +begin + ws1:=PCharToPWideChar(S1); + ws2:=PCharToPWideChar(S2); + Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, -1, ws2, -1) - 2; + FreeMem(ws2); + FreeMem(ws1); +end; + + +function WinCEAnsiStrIComp(S1, S2: PChar): PtrInt; +var + ws1, ws2: PWideChar; +begin + ws1:=PCharToPWideChar(S1); + ws2:=PCharToPWideChar(S2); + Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, -1, ws2, -1) - 2; + FreeMem(ws2); + FreeMem(ws1); +end; + + +function WinCEAnsiStrLComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt; +var + ws1, ws2: PWideChar; + len1, len2: longint; +begin + ws1:=PCharToPWideChar(S1, MaxLen, @len1); + ws2:=PCharToPWideChar(S2, MaxLen, @len2); + Result:=CompareString(LOCALE_USER_DEFAULT, 0, ws1, len1, ws2, len2) - 2; + FreeMem(ws2); + FreeMem(ws1); +end; + + +function WinCEAnsiStrLIComp(S1, S2: PChar; MaxLen: PtrUInt): PtrInt; +var + ws1, ws2: PWideChar; + len1, len2: longint; +begin + ws1:=PCharToPWideChar(S1, MaxLen, @len1); + ws2:=PCharToPWideChar(S2, MaxLen, @len2); + Result:=CompareString(LOCALE_USER_DEFAULT, NORM_IGNORECASE, ws1, len1, ws2, len2) - 2; + FreeMem(ws2); + FreeMem(ws1); +end; + + +function WinCEAnsiStrLower(Str: PChar): PChar; +var + buf: PWideChar; + len: longint; +begin + buf:=PCharToPWideChar(Str, -1, @len); + CharLowerBuff(buf, len); + WideToAnsiBuf(buf, -1, Result, len + 1); + FreeMem(buf); +end; + + +function WinCEAnsiStrUpper(Str: PChar): PChar; +var + buf: PWideChar; + len: longint; +begin + buf:=PCharToPWideChar(Str, -1, @len); + CharUpperBuff(buf, len); + WideToAnsiBuf(buf, -1, Result, len + 1); + FreeMem(buf); +end; + + +{ there is a similiar procedure in the system unit which inits the fields which + are relevant already for the system unit } +procedure InitWinCEWidestrings; + begin + widestringmanager.CompareWideStringProc:=@WinCECompareWideString; + widestringmanager.CompareTextWideStringProc:=@WinCECompareTextWideString; + + widestringmanager.UpperAnsiStringProc:=@WinCEAnsiUpperCase; + widestringmanager.LowerAnsiStringProc:=@WinCEAnsiLowerCase; + widestringmanager.CompareStrAnsiStringProc:=@WinCEAnsiCompareStr; + widestringmanager.CompareTextAnsiStringProc:=@WinCEAnsiCompareText; + widestringmanager.StrCompAnsiStringProc:=@WinCEAnsiStrComp; + widestringmanager.StrICompAnsiStringProc:=@WinCEAnsiStrIComp; + widestringmanager.StrLCompAnsiStringProc:=@WinCEAnsiStrLComp; + widestringmanager.StrLICompAnsiStringProc:=@WinCEAnsiStrLIComp; + widestringmanager.StrLowerAnsiStringProc:=@WinCEAnsiStrLower; + widestringmanager.StrUpperAnsiStringProc:=@WinCEAnsiStrUpper; + end; + + + +Initialization + InitWinCEWidestrings; + InitExceptions; { Initialize exceptions. OS independent } + InitInternational; { Initialize internationalization settings } + LoadVersionInfo; + SysConfigDir:='\Windows'; + +Finalization + DoneExceptions; + +end. diff --git a/rtl/wince/tthread.inc b/rtl/wince/tthread.inc new file mode 100644 index 0000000000..d2a2ce3d0c --- /dev/null +++ b/rtl/wince/tthread.inc @@ -0,0 +1,213 @@ +{ Thread management routines } + +const + CM_EXECPROC = $8FFF; + CM_DESTROYWINDOW = $8FFE; + +type + PRaiseFrame = ^TRaiseFrame; + TRaiseFrame = record + NextRaise: PRaiseFrame; + ExceptAddr: Pointer; + ExceptObject: TObject; + ExceptionRecord: pointer; {PExceptionRecord} + end; + +var + ThreadWindow: HWND; + ThreadCount: Integer; + { event that happens when gui thread is done executing the method +} + +function ThreadWndProc(Window: HWnd; AMessage:UInt; WParam : WParam; LParam: LParam): Longint; stdcall; + +begin + case AMessage of + CM_EXECPROC: + with TThread(lParam) do + begin + Result := 0; + try + FSynchronizeException := nil; + FMethod; + except +{ if RaiseList <> nil then + begin + FSynchronizeException := PRaiseFrame(RaiseList)^.ExceptObject; + PRaiseFrame(RaiseList)^.ExceptObject := nil; + end; } + end; + end; + CM_DESTROYWINDOW: + begin + DestroyWindow(Window); + Result := 0; + end; + else + Result := DefWindowProc(Window, AMessage, wParam, lParam); + end; +end; + +const + ThreadWindowClass: TWndClass = ( + style: 0; + lpfnWndProc: nil; + cbClsExtra: 0; + cbWndExtra: 0; + hInstance: 0; + hIcon: 0; + hCursor: 0; + hbrBackground: 0; + lpszMenuName: nil; + lpszClassName: 'TThreadWindow'); + +procedure AddThread; + + function AllocateWindow: HWND; + var + TempClass: TWndClass; + ClassRegistered: Boolean; + begin + ThreadWindowClass.hInstance := HInstance; + ThreadWindowClass.lpfnWndProc:=WndProc(@ThreadWndProc); + ClassRegistered := GetClassInfo(HInstance, ThreadWindowClass.lpszClassName, + @TempClass); + if not ClassRegistered or (TempClass.lpfnWndProc <> WndProc(@ThreadWndProc)) then + begin + if ClassRegistered then + Windows.UnregisterClass(ThreadWindowClass.lpszClassName, HInstance); + Windows.RegisterClass(ThreadWindowClass); + end; + Result := CreateWindow(ThreadWindowClass.lpszClassName, '', 0, + 0, 0, 0, 0, 0, 0, HInstance, nil); + end; + +begin + if ThreadCount = 0 then + ThreadWindow := AllocateWindow; + Inc(ThreadCount); +end; + +procedure RemoveThread; +begin + Dec(ThreadCount); + if ThreadCount = 0 then + PostMessage(ThreadWindow, CM_DESTROYWINDOW, 0, 0); +end; + +{ TThread } + +function ThreadProc(ThreadObjPtr: Pointer): Integer; +var + FreeThread: Boolean; + Thread: TThread absolute ThreadObjPtr; +begin + try + Thread.Execute; + except + Thread.FFatalException := TObject(AcquireExceptionObject); + end; + FreeThread := Thread.FFreeOnTerminate; + Result := Thread.FReturnValue; + Thread.FFinished := True; + Thread.DoTerminate; + if FreeThread then Thread.Free; +end; + +constructor TThread.Create(CreateSuspended: Boolean); +var + Flags: Integer; +begin + inherited Create; + AddThread; + FSuspended := CreateSuspended; + Flags := 0; + if CreateSuspended then Flags := CREATE_SUSPENDED; + FHandle := BeginThread(nil, 0, @ThreadProc, pointer(self), Flags, FThreadID); + FFatalException := nil; +end; + + +destructor TThread.Destroy; +begin + if not FFinished and not Suspended then + begin + Terminate; + WaitFor; + end; + if FHandle <> 0 then CloseHandle(FHandle); + FFatalException.Free; + FFatalException := nil; + inherited Destroy; + RemoveThread; +end; + +procedure TThread.CallOnTerminate; +begin + FOnTerminate(Self); +end; + +procedure TThread.DoTerminate; +begin + if Assigned(FOnTerminate) then + Synchronize(@CallOnTerminate); +end; + +const + Priorities: array [TThreadPriority] of Integer = + (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL, + THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL, + THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL); + +function TThread.GetPriority: TThreadPriority; +var + P: Integer; + I: TThreadPriority; +begin + P := GetThreadPriority(FHandle); + Result := tpNormal; + for I := Low(TThreadPriority) to High(TThreadPriority) do + if Priorities[I] = P then Result := I; +end; + +procedure TThread.SetPriority(Value: TThreadPriority); +begin + SetThreadPriority(FHandle, Priorities[Value]); +end; + + +procedure TThread.SetSuspended(Value: Boolean); +begin + if Value <> FSuspended then + if Value then + Suspend else + Resume; +end; + +procedure TThread.Suspend; +begin + FSuspended := True; + SuspendThread(FHandle); +end; + +procedure TThread.Resume; +begin + if ResumeThread(FHandle) = 1 then FSuspended := False; +end; + +procedure TThread.Terminate; +begin + FTerminated := True; +end; + +function TThread.WaitFor: Integer; +var + Msg: TMsg; +begin + if GetCurrentThreadID = MainThreadID then + while MsgWaitForMultipleObjects(1, FHandle, False, INFINITE, QS_SENDMESSAGE) = WAIT_OBJECT_0 + 1 do + PeekMessage(Msg, 0, 0, 0, PM_NOREMOVE) + else + WaitForSingleObject(ulong(FHandle), INFINITE); + GetExitCodeThread(FHandle, DWord(Result)); +end; diff --git a/rtl/wince/wininc/func.inc b/rtl/wince/wininc/func.inc index 2644356e93..69eea5b969 100644 --- a/rtl/wince/wininc/func.inc +++ b/rtl/wince/wininc/func.inc @@ -694,6 +694,29 @@ function SetEvent(hEvent:HANDLE):WINBOOL; //win32 version redirected function WindowFromPoint(Point:POINT):HWND; external UserDLLCore name 'WindowFromPoint'; +// SHGetSpecialFolderPath consts +const + CSIDL_PROGRAMS = $0002; + CSIDL_CONTROLS = $0003; + CSIDL_PRINTERS = $0004; + CSIDL_PERSONAL = $0005; + CSIDL_FAVORITES = $0006; + CSIDL_STARTUP = $0007; + CSIDL_RECENT = $0008; + CSIDL_SENDTO = $0009; + CSIDL_BITBUCKET = $000a; + CSIDL_STARTMENU = $000b; + CSIDL_DESKTOPDIRECTORY = $0010; + CSIDL_DRIVES = $0011; + CSIDL_NETWORK = $0012; + CSIDL_NETHOOD = $0013; + CSIDL_FONTS = $0014; + CSIDL_TEMPLATES = $0015; + CSIDL_APPDATA = $001a; + +function SHGetSpecialFolderPath(hwndOwner: HWND; lpszPath: LPTSTR; nFolder: LongInt; fCreate: BOOL): BOOL; + external 'coredll' name 'SHGetSpecialFolderPath'; + //end wince only {$endif WINCE} diff --git a/rtl/wince/wininc/redef.inc b/rtl/wince/wininc/redef.inc index 81c6a15919..4229cc7a2e 100644 --- a/rtl/wince/wininc/redef.inc +++ b/rtl/wince/wininc/redef.inc @@ -22,12 +22,87 @@ {$ifdef read_interface} //begin common win32 & wince + +// +// A language ID is a 16 bit value which is the combination of a +// primary language ID and a secondary language ID. The bits are +// allocated as follows: +// +// +-----------------------+-------------------------+ +// | Sublanguage ID | Primary Language ID | +// +-----------------------+-------------------------+ +// 15 10 9 0 bit +// +// +// Language ID creation/extraction macros: +// +// MAKELANGID - construct language id from a primary language id and +// a sublanguage id. +// PRIMARYLANGID - extract primary language id from a language id. +// SUBLANGID - extract sublanguage id from a language id. +// + +function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; +function PRIMARYLANGID(LangId: WORD): WORD; +function SUBLANGID(LangId: WORD): WORD; + +// +// A locale ID is a 32 bit value which is the combination of a +// language ID, a sort ID, and a reserved area. The bits are +// allocated as follows: +// +// +-------------+---------+-------------------------+ +// | Reserved | Sort ID | Language ID | +// +-------------+---------+-------------------------+ +// 31 20 19 16 15 0 bit +// +// +// Locale ID creation/extraction macros: +// +// MAKELCID - construct the locale id from a language id and a sort id. +// MAKESORTLCID - construct the locale id from a language id, sort id, and sort version. +// LANGIDFROMLCID - extract the language id from a locale id. +// SORTIDFROMLCID - extract the sort id from a locale id. +// SORTVERSIONFROMLCID - extract the sort version from a locale id. +// + +const + NLS_VALID_LOCALE_MASK = $000fffff; //winnt + +function MAKELCID(LangId, SortId: WORD): DWORD; //winnt +function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; //winnt +function LANGIDFROMLCID(LocaleId: LCID): WORD; //winnt +function SORTIDFROMLCID(LocaleId: LCID): WORD; //winnt +function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; //winnt + +// +// Default System and User IDs for language and locale. +// + +function LANG_SYSTEM_DEFAULT: WORD; //winnt +function LANG_USER_DEFAULT: WORD; //winnt +function LOCALE_SYSTEM_DEFAULT: DWORD; //+winnt +function LOCALE_USER_DEFAULT: DWORD; //+winnt +function LOCALE_NEUTRAL: DWORD; //winnt +function LOCALE_INVARIANT: DWORD; //winnt + + function GetVersionExW(var lpVersionInformation: TOSVersionInfoW): BOOL; external KernelDLL name 'GetVersionExW'; procedure GetLocalTime(var SystemTime: SYSTEMTIME); external KernelDLL name 'GetLocalTime'; function SetLocalTime(var lpSystemTime:SYSTEMTIME):WINBOOL; external KernelDLL name 'SetLocalTime'; function CreateProcessW(lpApplicationName: LPWSTR; lpCommandLine: LPWSTR; lpProcessAttributes, lpThreadAttributes: PSecurityAttributes; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment: Pointer; lpCurrentDirectory: LPWSTR; const lpStartupInfo: TStartupInfo; var lpProcessInformation: TProcessInformation): BOOL; external KernelDLL name 'CreateProcessW'; function GetExitCodeProcess(hProcess: THandle; var lpExitCode: DWORD): BOOL; external KernelDLL name 'GetExitCodeProcess'; +function ReadFile(hFile: THandle; var Buffer; nNumberOfBytesToRead: DWORD; var lpNumberOfBytesRead: DWORD; lpOverlapped: POverlapped): BOOL; external KernelDLL name 'ReadFile'; +function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; external KernelDLL name 'WriteFile'; +function SetFileTime(hFile:HANDLE; var lpCreationTime:FILETIME; var lpLastAccessTime:FILETIME; var lpLastWriteTime:FILETIME):WINBOOL; external KernelDLL name 'SetFileTime'; +procedure EnterCriticalSection(var CriticalSection : TRTLCriticalSection); external KernelDLL name 'EnterCriticalSection'; +procedure LeaveCriticalSection(var CriticalSection : TRTLCriticalSection); external KernelDLL name 'LeaveCriticalSection'; +function RegisterClassW(const lpWndClass: TWndClassW): ATOM; external UserDLLCore name 'RegisterClassW'; +//redirected to MsgWaitForMultipleObjectsEx +function MsgWaitForMultipleObjects(nCount: DWORD; var pHandles; fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD; +function PeekMessageW(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external UserDLLCore name 'PeekMessageW'; +function GetExitCodeThread(hThread: THandle; var lpExitCode: DWORD): BOOL; external KernelDLL name 'GetExitCodeThread'; //end common win32 & wince {$ifdef WINCE} @@ -37,6 +112,8 @@ function CreateProcess(lpApplicationName: LPTSTR; lpCommandLine: LPTSTR; lpProce const lpStartupInfo: LPStartupInfo; var lpProcessInformation: TProcessInformation): BOOL;external KernelDLL name 'CreateProcessW'; function FindFirstFile(lpFileName: LPTSTR; var lpFindFileData: TWIN32FindData): THandle; external KernelDLL name 'FindFirstFileW'; function FindNextFile(hFindFile: THandle; var lpFindFileData: TWIN32FindData): BOOL; external KernelDLL name 'FindNextFileW'; +function RegisterClass(const lpWndClass: TWndClass): ATOM;external UserDLLCore name 'RegisterClassW'; +function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL;external UserDLLCore name 'PeekMessageW'; //end wince only {$endif WINCE} @@ -132,70 +209,6 @@ const FACILITY_NT_BIT = $10000000; HFILE_ERROR = HFILE(-1); -// -// A language ID is a 16 bit value which is the combination of a -// primary language ID and a secondary language ID. The bits are -// allocated as follows: -// -// +-----------------------+-------------------------+ -// | Sublanguage ID | Primary Language ID | -// +-----------------------+-------------------------+ -// 15 10 9 0 bit -// -// -// Language ID creation/extraction macros: -// -// MAKELANGID - construct language id from a primary language id and -// a sublanguage id. -// PRIMARYLANGID - extract primary language id from a language id. -// SUBLANGID - extract sublanguage id from a language id. -// - -function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; -function PRIMARYLANGID(LangId: WORD): WORD; -function SUBLANGID(LangId: WORD): WORD; - -// -// A locale ID is a 32 bit value which is the combination of a -// language ID, a sort ID, and a reserved area. The bits are -// allocated as follows: -// -// +-------------+---------+-------------------------+ -// | Reserved | Sort ID | Language ID | -// +-------------+---------+-------------------------+ -// 31 20 19 16 15 0 bit -// -// -// Locale ID creation/extraction macros: -// -// MAKELCID - construct the locale id from a language id and a sort id. -// MAKESORTLCID - construct the locale id from a language id, sort id, and sort version. -// LANGIDFROMLCID - extract the language id from a locale id. -// SORTIDFROMLCID - extract the sort id from a locale id. -// SORTVERSIONFROMLCID - extract the sort version from a locale id. -// - -const - NLS_VALID_LOCALE_MASK = $000fffff; //winnt - -function MAKELCID(LangId, SortId: WORD): DWORD; //winnt -function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; //winnt -function LANGIDFROMLCID(LocaleId: LCID): WORD; //winnt -function SORTIDFROMLCID(LocaleId: LCID): WORD; //winnt -function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; //winnt - -// -// Default System and User IDs for language and locale. -// - -function LANG_SYSTEM_DEFAULT: WORD; //winnt -function LANG_USER_DEFAULT: WORD; //winnt -function LOCALE_SYSTEM_DEFAULT: DWORD; //+winnt -function LOCALE_USER_DEFAULT: DWORD; //+winnt -function LOCALE_NEUTRAL: DWORD; //winnt -function LOCALE_INVARIANT: DWORD; //winnt - - function Succeeded(Status : HRESULT) : BOOL; function Failed(Status : HRESULT) : BOOL; function IsError(Status : HRESULT) : BOOL; @@ -207,8 +220,6 @@ function HResultFromWin32(x : Longint) : HRESULT; function HResultFromNT(x : Longint) : HRESULT; procedure InitializeCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'InitializeCriticalSection'; -procedure EnterCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'EnterCriticalSection'; -procedure LeaveCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'LeaveCriticalSection'; procedure DeleteCriticalSection(var CriticalSection : TRTLCriticalSection); external 'kernel32' name 'DeleteCriticalSection'; function InitializeCriticalSectionAndSpinCount(var CriticalSection : TRTLCriticalSection;dwSpinCount : DWORD) : BOOL; external 'kernel32' name 'InitializeCriticalSectionAndSpinCount'; function SetCriticalSectionSpinCount(var CriticalSection : TRTLCriticalSection;dwSpinCount : DWORD ): DWORD; external 'kernel32' name 'SetCriticalSectionSpinCount'; @@ -485,7 +496,6 @@ function GetDiskFreeSpaceEx(lpDirectoryName: PChar; lpFreeBytesAvailableToCalle function GetDiskFreeSpaceExA(lpDirectoryName: LPCSTR; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExA'; function GetDiskFreeSpaceExW(lpDirectoryName: LPWSTR; lpFreeBytesAvailableToCaller, lpTotalNumberOfBytes: pLargeInteger; lpTotalNumberOfFreeBytes: PLargeInteger): BOOL;external 'kernel32' name 'GetDiskFreeSpaceExW'; //function GetEnhMetaFilePixelFormat(p1: HENHMETAFILE; p2: Cardinal; var p3: TPixelFormatDescriptor): UINT;external 'gdi32' name 'GetEnhMetaFilePixelFormat'; -function GetExitCodeThread(hThread: THandle; var lpExitCode: DWORD): BOOL; external 'kernel32' name 'GetExitCodeThread'; function GetFileInformationByHandle(hFile: THandle; var lpFileInformation: TByHandleFileInformation): BOOL; external 'kernel32' name 'GetFileInformationByHandle'; //function GetFileSecurity(lpFileName: PChar; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL;external 'advapi32' name 'GetFileSecurityA'; //function GetFileSecurityA(lpFileName: LPCSTR; RequestedInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; nLength: DWORD; var lpnLengthNeeded: DWORD): BOOL; external 'advapi32' name 'GetFileSecurityA'; @@ -674,7 +684,6 @@ function MessageBoxIndirect(const MsgBoxParams: TMsgBoxParams): BOOL;external 'u function MessageBoxIndirectA(const MsgBoxParams: TMsgBoxParamsA): BOOL; external 'user32' name 'MessageBoxIndirectA'; //function MessageBoxIndirectW(const MsgBoxParams: TMsgBoxParamsW): BOOL; external 'user32' name 'MessageBoxIndirectW'; //function ModifyWorldTransform(DC: HDC; const p2: TXForm; p3: DWORD): BOOL; external 'gdi32' name 'ModifyWorldTransform'; -function MsgWaitForMultipleObjects(nCount: DWORD; var pHandles; fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD;external 'user32' name 'MsgWaitForMultipleObjects'; {$ifdef support_smartlink} function MsgWaitForMultipleObjectsEx(nCount: DWORD; var pHandles; dwMilliseconds, dwWakeMask, dwFlags: DWORD): DWORD;external 'user32' name 'MsgWaitForMultipleObjectsEx'; {$endif support_smartlink} @@ -698,9 +707,7 @@ function OpenThreadToken(ThreadHandle: THandle; DesiredAccess: DWORD; OpenAsSelf function PeekConsoleInput(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL;external 'kernel32' name 'PeekConsoleInputA'; function PeekConsoleInputA(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'PeekConsoleInputA'; function PeekConsoleInputW(hConsoleInput: THandle; var lpBuffer: TInputRecord; nLength: DWORD; var lpNumberOfEventsRead: DWORD): BOOL; external 'kernel32' name 'PeekConsoleInputW'; -function PeekMessage(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL;external 'user32' name 'PeekMessageA'; function PeekMessageA(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'user32' name 'PeekMessageA'; -function PeekMessageW(var lpMsg: TMsg; hWnd: HWND; wMsgFilterMin, wMsgFilterMax, wRemoveMsg: UINT): BOOL; external 'user32' name 'PeekMessageW'; //function PlayEnhMetaFile(DC: HDC; p2: HENHMETAFILE; const p3: TRect): BOOL; external 'gdi32' name 'PlayEnhMetaFile'; function PlayEnhMetaFileRecord(DC: HDC; var p2: THandleTable; const p3: TEnhMetaRecord; p4: UINT): BOOL; external 'gdi32' name 'PlayEnhMetaFileRecord'; function PlayMetaFileRecord(DC: HDC; const p2: THandleTable; const p3: TMetaRecord; p4: UINT): BOOL; external 'gdi32' name 'PlayMetaFileRecord'; @@ -744,7 +751,6 @@ function ReadConsoleW(hConsoleInput: THandle; lpBuffer: Pointer; nNumberOfCharsT function ReadEventLog(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL;external 'advapi32' name 'ReadEventLogA'; function ReadEventLogA(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL; external 'advapi32' name 'ReadEventLogA'; function ReadEventLogW(hEventLog: THandle; dwReadFlags, dwRecordOffset: DWORD; lpBuffer: Pointer; nNumberOfBytesToRead: DWORD; var pnBytesRead, pnMinNumberOfBytesNeeded: DWORD): BOOL; external 'advapi32' name 'ReadEventLogW'; -function ReadFile(hFile: THandle; var Buffer; nNumberOfBytesToRead: DWORD; var lpNumberOfBytesRead: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'ReadFile'; function ReadProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesRead: DWORD): BOOL; external 'kernel32' name 'ReadProcessMemory'; //function RectInRegion(RGN: HRGN; const p2: TRect): BOOL; external 'gdi32' name 'RectInRegion'; //function RectVisible(DC: HDC; const Rect: TRect): BOOL; external 'gdi32' name 'RectVisible'; @@ -767,12 +773,10 @@ function RegEnumValue(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbVa function RegEnumValueA(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; external 'advapi32' name 'RegEnumValueA'; function RegEnumValueW(hKey: HKEY; dwIndex: DWORD; lpValueName: PChar; var lpcbValueName: DWORD; lpReserved: Pointer; lpType: PDWORD; lpData: PByte; lpcbData: PDWORD): Longint; external 'advapi32' name 'RegEnumValueW'; function RegGetKeySecurity(hKey: HKEY; SecurityInformation: SECURITY_INFORMATION; pSecurityDescriptor: PSecurityDescriptor; var lpcbSecurityDescriptor: DWORD): Longint; external 'advapi32' name 'RegGetKeySecurity'; -function RegisterClass(const lpWndClass: TWndClass): ATOM;external 'user32' name 'RegisterClassA'; function RegisterClassA(const lpWndClass: TWndClassA): ATOM; external 'user32' name 'RegisterClassA'; function RegisterClassEx(const WndClass: TWndClassEx): ATOM;external 'user32' name 'RegisterClassExA'; function RegisterClassExA(const WndClass: TWndClassExA): ATOM; external 'user32' name 'RegisterClassExA'; function RegisterClassExW(const WndClass: TWndClassExW): ATOM; external 'user32' name 'RegisterClassExW'; -function RegisterClassW(const lpWndClass: TWndClassW): ATOM; external 'user32' name 'RegisterClassW'; function RegOpenKey(hKey: HKEY; lpSubKey: PChar; var phkResult: HKEY): Longint;external 'advapi32' name 'RegOpenKeyA'; function RegOpenKeyA(hKey: HKEY; lpSubKey: LPCSTR; var phkResult: HKEY): Longint; external 'advapi32' name 'RegOpenKeyA'; function RegOpenKeyEx(hKey: HKEY; lpSubKey: PChar; ulOptions: DWORD; samDesired: REGSAM; var phkResult: HKEY): Longint;external 'advapi32' name 'RegOpenKeyExA'; @@ -816,7 +820,6 @@ function SetDeviceGammaRamp(DC: HDC; var Ramp): BOOL; external 'gdi32' name 'Set function SetDIBColorTable(DC: HDC; p2, p3: UINT; var RGBQuadSTructs): UINT; external 'gdi32' name 'SetDIBColorTable'; function SetDIBits(DC: HDC; Bitmap: HBITMAP; StartScan, NumScans: UINT; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'SetDIBits'; //function SetDIBitsToDevice(DC: HDC; DestX, DestY: Integer; Width, Height: DWORD; SrcX, SrcY: Integer; nStartScan, NumScans: UINT; Bits: Pointer; var BitsInfo: TBitmapInfo; Usage: UINT): Integer; external 'gdi32' name 'SetDIBitsToDevice'; -function SetFileTime(hFile:HANDLE; var lpCreationTime:FILETIME; var lpLastAccessTime:FILETIME; var lpLastWriteTime:FILETIME):WINBOOL; external 'kernel32' name 'SetFileTime'; //function SetKeyboardState(var KeyState: TKeyboardState): BOOL; external 'user32' name 'SetKeyboardState'; //function SetLocalTime(const lpSystemTime: TSystemTime): BOOL; external 'kernel32' name 'SetLocalTime'; //function SetMenuInfo(hMenu: HMENU; const lpcmi: TMenuInfo): BOOL;external 'user32' name 'SetMenuInfo'; @@ -945,7 +948,6 @@ function WriteConsoleOutputCharacterA(hConsoleOutput: THandle;lpCharacter: LPCST function WriteConsoleOutputCharacterW(hConsoleOutput: THandle;lpCharacter: LPWSTR; nLength: DWORD; dwWriteCoord: TCoord; var lpNumberOfCharsWritten: DWORD): BOOL; external 'kernel32' name 'WriteConsoleOutputCharacterW'; function WriteConsoleOutputW(hConsoleOutput: THandle; lpBuffer: Pointer; dwBufferSize, dwBufferCoord: TCoord; var lpWriteRegion: TSmallRect): BOOL; external 'kernel32' name 'WriteConsoleOutputW'; function WriteConsoleW(hConsoleOutput: THandle; const lpBuffer: Pointer; nNumberOfCharsToWrite: DWORD; var lpNumberOfCharsWritten: DWORD; lpReserved: Pointer): BOOL; external 'kernel32' name 'WriteConsoleW'; -function WriteFile(hFile: THandle; const Buffer; nNumberOfBytesToWrite: DWORD; var lpNumberOfBytesWritten: DWORD; lpOverlapped: POverlapped): BOOL; external 'kernel32' name 'WriteFile'; function WriteFileEx(hFile: THandle; lpBuffer: Pointer; nNumberOfBytesToWrite: DWORD; const lpOverlapped: TOverlapped; lpCompletionRoutine: FARPROC): BOOL; external 'kernel32' name 'WriteFileEx'; function WriteProcessMemory(hProcess: THandle; const lpBaseAddress: Pointer; lpBuffer: Pointer; nSize: DWORD; var lpNumberOfBytesWritten: DWORD): BOOL; external 'kernel32' name 'WriteProcessMemory'; @@ -972,10 +974,86 @@ function AnsiLowerBuff(lpsz:LPSTR; cchLength:DWORD):DWORD; external 'user32' nam {$ifdef read_implementation} //begin common win32 & wince +function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; +begin + MAKELANGID := (SubLang shl 10) or PrimaryLang; +end; + +function PRIMARYLANGID(LangId: WORD): WORD; +begin + PRIMARYLANGID := LangId and $3FF; +end; + +function SUBLANGID(LangId: WORD): WORD; +begin + SUBLANGID := LangId shr 10; +end; + +function MAKELCID(LangId, SortId: WORD): DWORD; +begin + MAKELCID := (DWORD(SortId) shl 16) or DWORD(LangId); +end; + +function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; +begin + MAKESORTLCID := MAKELCID(LangId, SortId) or (SortVersion shl 20); +end; + +function LANGIDFROMLCID(LocaleId: LCID): WORD; +begin + LANGIDFROMLCID := WORD(LocaleId); +end; + +function SORTIDFROMLCID(LocaleId: LCID): WORD; +begin + SORTIDFROMLCID := WORD((DWORD(LocaleId) shr 16) and $F); +end; + +function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; +begin + SORTVERSIONFROMLCID := WORD((DWORD(LocaleId) shr 20) and $F); +end; + +function LANG_SYSTEM_DEFAULT: WORD; +begin + LANG_SYSTEM_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT); +end; + +function LANG_USER_DEFAULT: WORD; +begin + LANG_USER_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT); +end; + +function LOCALE_USER_DEFAULT: DWORD; +begin + LOCALE_USER_DEFAULT:= MAKELCID(LANG_USER_DEFAULT, SORT_DEFAULT); +end; + +function LOCALE_SYSTEM_DEFAULT: DWORD; +begin + LOCALE_SYSTEM_DEFAULT:= MAKELCID(LANG_SYSTEM_DEFAULT, SORT_DEFAULT); +end; + +function LOCALE_NEUTRAL: DWORD; +begin + LOCALE_NEUTRAL := MAKELCID(MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL), SORT_DEFAULT); +end; + +function LOCALE_INVARIANT: DWORD; +begin + LOCALE_INVARIANT := MAKELCID(MAKELANGID(LANG_INVARIANT, SUBLANG_NEUTRAL), SORT_DEFAULT); +end; + //end common win32 & wince {$ifdef WINCE} //begin wince only + +function MsgWaitForMultipleObjects(nCount: DWORD; var pHandles; fWaitAll: BOOL; dwMilliseconds, dwWakeMask: DWORD): DWORD; +begin + MsgWaitForMultipleObjects:=MsgWaitForMultipleObjectsEx(nCount,@pHandles,dwMilliseconds,dwWakeMask,0); +end; + //end wince only {$endif WINCE} @@ -1029,75 +1107,6 @@ function HResultFromNT(x : Longint) : HRESULT; HResultFromNT:=x or FACILITY_NT_BIT; end; -function MAKELANGID(PrimaryLang, SubLang: USHORT): WORD; -begin - MAKELANGID := (SubLang shl 10) or PrimaryLang; -end; - -function PRIMARYLANGID(LangId: WORD): WORD; -begin - PRIMARYLANGID := LangId and $3FF; -end; - -function SUBLANGID(LangId: WORD): WORD; -begin - SUBLANGID := LangId shr 10; -end; - -function MAKELCID(LangId, SortId: WORD): DWORD; -begin - MAKELCID := (DWORD(SortId) shl 16) or DWORD(LangId); -end; - -function MAKESORTLCID(LangId, SortId, SortVersion: WORD): DWORD; -begin - MAKESORTLCID := MAKELCID(LangId, SortId) or (SortVersion shl 20); -end; - -function LANGIDFROMLCID(LocaleId: LCID): WORD; -begin - LANGIDFROMLCID := WORD(LocaleId); -end; - -function SORTIDFROMLCID(LocaleId: LCID): WORD; -begin - SORTIDFROMLCID := WORD((DWORD(LocaleId) shr 16) and $F); -end; - -function SORTVERSIONFROMLCID(LocaleId: LCID): WORD; -begin - SORTVERSIONFROMLCID := WORD((DWORD(LocaleId) shr 20) and $F); -end; - -function LANG_SYSTEM_DEFAULT: WORD; -begin - LANG_SYSTEM_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_SYS_DEFAULT); -end; - -function LANG_USER_DEFAULT: WORD; -begin - LANG_USER_DEFAULT := MAKELANGID(LANG_NEUTRAL, SUBLANG_DEFAULT); -end; - -function LOCALE_SYSTEM_DEFAULT: DWORD; -begin - LOCALE_SYSTEM_DEFAULT:= MAKELCID(LANG_SYSTEM_DEFAULT, SORT_DEFAULT); -end; - -function LOCALE_USER_DEFAULT: DWORD; -begin - LOCALE_USER_DEFAULT:= MAKELCID(LANG_USER_DEFAULT, SORT_DEFAULT); -end; - -function LOCALE_NEUTRAL: DWORD; -begin - LOCALE_NEUTRAL := MAKELCID(MAKELANGID(LANG_NEUTRAL, SUBLANG_NEUTRAL), SORT_DEFAULT); -end; - -function LOCALE_INVARIANT: DWORD; -begin - LOCALE_INVARIANT := MAKELCID(MAKELANGID(LANG_INVARIANT, SUBLANG_NEUTRAL), SORT_DEFAULT); -end; //end win32 or wince not checked {$endif WIN32}