paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-20 11:09:42 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Implemented cross-platform version of fileinfo

Browse Source 
git-svn-id: trunk@23318 -
This commit is contained in:
michael 2013-01-06 14:52:06 +00:00
parent 4f30ac0247
commit 64f8c451d9
6 changed files with 652 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
.gitattributes vendored
View File

@ -1873,6 +1873,7 @@ packages/fcl-base/src/contnrs.pp svneol=native#text/plain
packages/fcl-base/src/custapp.pp svneol=native#text/plain
packages/fcl-base/src/dummy/eventlog.inc svneol=native#text/plain
packages/fcl-base/src/eventlog.pp svneol=native#text/plain
packages/fcl-base/src/fileinfo.pp svneol=native#text/plain
packages/fcl-base/src/fpexprpars.pp svneol=native#text/plain
packages/fcl-base/src/fpmimetypes.pp svneol=native#text/plain
packages/fcl-base/src/fpobserver.pp svneol=native#text/plain
@ -1906,7 +1907,6 @@ packages/fcl-base/src/win/eventlog.inc svneol=native#text/plain
packages/fcl-base/src/win/fclel.mc -text
packages/fcl-base/src/win/fclel.rc -text
packages/fcl-base/src/win/fclel.res -text
packages/fcl-base/src/win/fileinfo.pp svneol=native#text/plain
packages/fcl-base/src/wince/fileinfo.pp svneol=native#text/plain
packages/fcl-base/src/wtex.pp svneol=native#text/plain
packages/fcl-base/tests/fclbase-unittests.lpi svneol=native#text/plain

112
packages/fcl-base/Makefile
View File

@ -1,5 +1,5 @@
#
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/11/11]
# Don't edit, this file is generated by FPCMake Version 2.0.0 [2012/12/01]
#
default: all
MAKEFILETARGETS=i386-linux i386-go32v2 i386-win32 i386-os2 i386-freebsd i386-beos i386-haiku i386-netbsd i386-solaris i386-qnx i386-netware i386-openbsd i386-wdosx i386-darwin i386-emx i386-watcom i386-netwlibc i386-wince i386-embedded i386-symbian i386-nativent i386-iphonesim m68k-linux m68k-freebsd m68k-netbsd m68k-amiga m68k-atari m68k-openbsd m68k-palmos m68k-embedded powerpc-linux powerpc-netbsd powerpc-amiga powerpc-macos powerpc-darwin powerpc-morphos powerpc-embedded powerpc-wii powerpc-aix sparc-linux sparc-netbsd sparc-solaris sparc-embedded x86_64-linux x86_64-freebsd x86_64-netbsd x86_64-solaris x86_64-openbsd x86_64-darwin x86_64-win64 x86_64-embedded arm-linux arm-palmos arm-darwin arm-wince arm-gba arm-nds arm-embedded arm-symbian powerpc64-linux powerpc64-darwin powerpc64-embedded powerpc64-aix avr-embedded armeb-linux armeb-embedded mips-linux mipsel-linux jvm-java jvm-android
@ -923,13 +923,14 @@ else
TAROPT=vz
TAREXT=.tar.gz
endif
override REQUIRE_PACKAGES=rtl fpmkunit
override REQUIRE_PACKAGES=rtl fpmkunit fcl-res
ifeq ($(FULL_TARGET),i386-linux)
REQUIRE_PACKAGES_RTL=1
REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-go32v2)
REQUIRE_PACKAGES_RTL=1
@ -937,6 +938,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-win32)
REQUIRE_PACKAGES_RTL=1
@ -944,6 +946,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-os2)
REQUIRE_PACKAGES_RTL=1
@ -951,6 +954,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-freebsd)
REQUIRE_PACKAGES_RTL=1
@ -958,6 +962,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-beos)
REQUIRE_PACKAGES_RTL=1
@ -965,6 +970,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-haiku)
REQUIRE_PACKAGES_RTL=1
@ -972,6 +978,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-netbsd)
REQUIRE_PACKAGES_RTL=1
@ -979,6 +986,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-solaris)
REQUIRE_PACKAGES_RTL=1
@ -986,6 +994,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-qnx)
REQUIRE_PACKAGES_RTL=1
@ -993,6 +1002,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-netware)
REQUIRE_PACKAGES_RTL=1
@ -1000,6 +1010,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-openbsd)
REQUIRE_PACKAGES_RTL=1
@ -1007,6 +1018,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-wdosx)
REQUIRE_PACKAGES_RTL=1
@ -1014,6 +1026,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-darwin)
REQUIRE_PACKAGES_RTL=1
@ -1021,6 +1034,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-emx)
REQUIRE_PACKAGES_RTL=1
@ -1028,6 +1042,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-watcom)
REQUIRE_PACKAGES_RTL=1
@ -1035,6 +1050,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-netwlibc)
REQUIRE_PACKAGES_RTL=1
@ -1042,6 +1058,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-wince)
REQUIRE_PACKAGES_RTL=1
@ -1049,6 +1066,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-embedded)
REQUIRE_PACKAGES_RTL=1
@ -1056,6 +1074,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-symbian)
REQUIRE_PACKAGES_RTL=1
@ -1063,6 +1082,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-nativent)
REQUIRE_PACKAGES_RTL=1
@ -1070,6 +1090,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),i386-iphonesim)
REQUIRE_PACKAGES_RTL=1
@ -1077,6 +1098,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),m68k-linux)
REQUIRE_PACKAGES_RTL=1
@ -1084,6 +1106,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),m68k-freebsd)
REQUIRE_PACKAGES_RTL=1
@ -1091,6 +1114,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),m68k-netbsd)
REQUIRE_PACKAGES_RTL=1
@ -1098,6 +1122,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),m68k-amiga)
REQUIRE_PACKAGES_RTL=1
@ -1105,6 +1130,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),m68k-atari)
REQUIRE_PACKAGES_RTL=1
@ -1112,6 +1138,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),m68k-openbsd)
REQUIRE_PACKAGES_RTL=1
@ -1119,6 +1146,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),m68k-palmos)
REQUIRE_PACKAGES_RTL=1
@ -1126,6 +1154,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),m68k-embedded)
REQUIRE_PACKAGES_RTL=1
@ -1133,6 +1162,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc-linux)
REQUIRE_PACKAGES_RTL=1
@ -1140,6 +1170,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc-netbsd)
REQUIRE_PACKAGES_RTL=1
@ -1147,6 +1178,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc-amiga)
REQUIRE_PACKAGES_RTL=1
@ -1154,6 +1186,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc-macos)
REQUIRE_PACKAGES_RTL=1
@ -1161,6 +1194,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc-darwin)
REQUIRE_PACKAGES_RTL=1
@ -1168,6 +1202,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc-morphos)
REQUIRE_PACKAGES_RTL=1
@ -1175,6 +1210,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc-embedded)
REQUIRE_PACKAGES_RTL=1
@ -1182,6 +1218,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc-wii)
REQUIRE_PACKAGES_RTL=1
@ -1189,6 +1226,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc-aix)
REQUIRE_PACKAGES_RTL=1
@ -1196,6 +1234,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),sparc-linux)
REQUIRE_PACKAGES_RTL=1
@ -1203,6 +1242,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),sparc-netbsd)
REQUIRE_PACKAGES_RTL=1
@ -1210,6 +1250,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),sparc-solaris)
REQUIRE_PACKAGES_RTL=1
@ -1217,6 +1258,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),sparc-embedded)
REQUIRE_PACKAGES_RTL=1
@ -1224,6 +1266,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),x86_64-linux)
REQUIRE_PACKAGES_RTL=1
@ -1231,6 +1274,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),x86_64-freebsd)
REQUIRE_PACKAGES_RTL=1
@ -1238,6 +1282,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),x86_64-netbsd)
REQUIRE_PACKAGES_RTL=1
@ -1245,6 +1290,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),x86_64-solaris)
REQUIRE_PACKAGES_RTL=1
@ -1252,6 +1298,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),x86_64-openbsd)
REQUIRE_PACKAGES_RTL=1
@ -1259,6 +1306,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),x86_64-darwin)
REQUIRE_PACKAGES_RTL=1
@ -1266,6 +1314,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),x86_64-win64)
REQUIRE_PACKAGES_RTL=1
@ -1273,6 +1322,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),x86_64-embedded)
REQUIRE_PACKAGES_RTL=1
@ -1280,6 +1330,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),arm-linux)
REQUIRE_PACKAGES_RTL=1
@ -1287,6 +1338,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),arm-palmos)
REQUIRE_PACKAGES_RTL=1
@ -1294,6 +1346,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),arm-darwin)
REQUIRE_PACKAGES_RTL=1
@ -1301,6 +1354,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),arm-wince)
REQUIRE_PACKAGES_RTL=1
@ -1308,6 +1362,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),arm-gba)
REQUIRE_PACKAGES_RTL=1
@ -1315,6 +1370,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),arm-nds)
REQUIRE_PACKAGES_RTL=1
@ -1322,6 +1378,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),arm-embedded)
REQUIRE_PACKAGES_RTL=1
@ -1329,6 +1386,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),arm-symbian)
REQUIRE_PACKAGES_RTL=1
@ -1336,6 +1394,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc64-linux)
REQUIRE_PACKAGES_RTL=1
@ -1343,6 +1402,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc64-darwin)
REQUIRE_PACKAGES_RTL=1
@ -1350,6 +1410,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc64-embedded)
REQUIRE_PACKAGES_RTL=1
@ -1357,6 +1418,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),powerpc64-aix)
REQUIRE_PACKAGES_RTL=1
@ -1364,6 +1426,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),avr-embedded)
REQUIRE_PACKAGES_RTL=1
@ -1371,6 +1434,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),armeb-linux)
REQUIRE_PACKAGES_RTL=1
@ -1378,6 +1442,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),armeb-embedded)
REQUIRE_PACKAGES_RTL=1
@ -1385,6 +1450,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),mips-linux)
REQUIRE_PACKAGES_RTL=1
@ -1392,6 +1458,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),mipsel-linux)
REQUIRE_PACKAGES_RTL=1
@ -1399,6 +1466,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),jvm-java)
REQUIRE_PACKAGES_RTL=1
@ -1406,6 +1474,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifeq ($(FULL_TARGET),jvm-android)
REQUIRE_PACKAGES_RTL=1
@ -1413,6 +1482,7 @@ REQUIRE_PACKAGES_PASZLIB=1
REQUIRE_PACKAGES_FCL-PROCESS=1
REQUIRE_PACKAGES_HASH=1
REQUIRE_PACKAGES_FPMKUNIT=1
REQUIRE_PACKAGES_FCL-RES=1
endif
ifdef REQUIRE_PACKAGES_RTL
PACKAGEDIR_RTL:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /rtl/Makefile.fpc,$(PACKAGESDIR))))))
@ -1604,6 +1674,44 @@ ifdef UNITDIR_FPMAKE_FPMKUNIT
override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FPMKUNIT)
endif
endif
ifdef REQUIRE_PACKAGES_FCL-RES
PACKAGEDIR_FCL-RES:=$(firstword $(subst /Makefile.fpc,,$(strip $(wildcard $(addsuffix /fcl-res/Makefile.fpc,$(PACKAGESDIR))))))
ifneq ($(PACKAGEDIR_FCL-RES),)
ifneq ($(wildcard $(PACKAGEDIR_FCL-RES)/units/$(TARGETSUFFIX)),)
UNITDIR_FCL-RES=$(PACKAGEDIR_FCL-RES)/units/$(TARGETSUFFIX)
else
UNITDIR_FCL-RES=$(PACKAGEDIR_FCL-RES)
endif
ifneq ($(wildcard $(PACKAGEDIR_FCL-RES)/units/$(SOURCESUFFIX)),)
UNITDIR_FPMAKE_FCL-RES=$(PACKAGEDIR_FCL-RES)/units/$(SOURCESUFFIX)
else
ifneq ($(wildcard $(PACKAGEDIR_FCL-RES)/units_bs/$(SOURCESUFFIX)),)
UNITDIR_FPMAKE_FCL-RES=$(PACKAGEDIR_FCL-RES)/units_bs/$(SOURCESUFFIX)
else
UNITDIR_FPMAKE_FCL-RES=$(PACKAGEDIR_FCL-RES)
endif
endif
ifdef CHECKDEPEND
$(PACKAGEDIR_FCL-RES)/$(FPCMADE):
$(MAKE) -C $(PACKAGEDIR_FCL-RES) $(FPCMADE)
override ALLDEPENDENCIES+=$(PACKAGEDIR_FCL-RES)/$(FPCMADE)
endif
else
PACKAGEDIR_FCL-RES=
UNITDIR_FCL-RES:=$(subst /Package.fpc,,$(strip $(wildcard $(addsuffix /fcl-res/Package.fpc,$(UNITSDIR)))))
ifneq ($(UNITDIR_FCL-RES),)
UNITDIR_FCL-RES:=$(firstword $(UNITDIR_FCL-RES))
else
UNITDIR_FCL-RES=
endif
endif
ifdef UNITDIR_FCL-RES
override COMPILER_UNITDIR+=$(UNITDIR_FCL-RES)
endif
ifdef UNITDIR_FPMAKE_FCL-RES
override COMPILER_FPMAKE_UNITDIR+=$(UNITDIR_FPMAKE_FCL-RES)
endif
endif
ifndef NOCPUDEF
override FPCOPTDEF=$(ARCH)
endif

2
packages/fcl-base/Makefile.fpc
View File

@ -7,7 +7,7 @@ name=fcl-base
version=2.7.1
[require]
packages=rtl fpmkunit
packages=rtl fpmkunit fcl-res
[install]
fpcpackage=y

3
packages/fcl-base/fpmake.pp
View File

@ -18,6 +18,7 @@ begin
{$endif ALLPACKAGES}
P.Version:='2.7.1';
P.Dependencies.Add('univint',[Darwin,iPhoneSim]);
P.Dependencies.Add('fcl-res');
P.Author := '<various>';
P.License := 'LGPL with modification, ';
@ -106,7 +107,7 @@ begin
T.ResourceStrings:=true;
// Windows units
T:=P.Targets.AddUnit('fileinfo.pp',AllWindowsOSes);
T:=P.Targets.AddUnit('fileinfo.pp');
T:=P.Targets.addUnit('fpmimetypes.pp');
// Additional sources

538
packages/fcl-base/src/fileinfo.pp Normal file
View File

@ -0,0 +1,538 @@
{
This file is part of the Free Component Library (FCL)
Copyright (c) 2013 by the Free Pascal development team
File/Program version information 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.
**********************************************************************}
unit fileinfo;
{$mode objfpc}
{$h+}
interface
uses
SysUtils, Classes, resource, versiontypes, versionresource;
type
// Low level interface
{ TVersionInfo }
TVersionInfo = class
private
FResources : TResources;
FVersionInfo : TVersionResource;
procedure CheckLoaded;
procedure FreeResources;
function GetFixedInfo: TVersionFixedInfo;
function GetStringFileInfo: TVersionStringFileInfo;
function GetVarFileInfo: TVersionVarFileInfo;
public
constructor Create;
destructor Destroy; override;
procedure Load(Const Instance: THandle); overload;
procedure Load(Const AFileName : string); overload;
property FixedInfo: TVersionFixedInfo read GetFixedInfo;
property StringFileInfo: TVersionStringFileInfo read GetStringFileInfo;
property VarFileInfo: TVersionVarFileInfo read GetVarFileInfo;
end;
type
// Higher level interface
{ TFileVersionInfo }
TFileVersionInfo = class(TComponent)
private
FEnabled: Boolean;
FFileName : String;
FFilter : TStrings;
FTranslation: String;
FTranslationOnly: Boolean;
FVersionStrings: TStrings;
procedure CheckRead;
Procedure FilterChange(Sender : TObject);
procedure SetEnabled(AValue: Boolean);
procedure SetFileName (Const AFileName : String);
procedure SetFilter(AValue: TStrings);
procedure SetTranslation(AValue: String);
procedure SetTranslationOnly(AValue: Boolean);
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
Procedure Loaded; override;
// Read info from file "FileName".
procedure ReadFileInfo;
published
// If True, the info will be read as soon as a property changes.
Property Enabled : Boolean Read FEnabled Write SetEnabled;
// Filename to read version info from.
property FileName : string read FFileName write SetFileName;
// Extracted version information.
property VersionStrings : TStrings read FVersionStrings;
// Set of key namess to read. If Empty, all keys are read.
property Filter : TStrings read FFilter Write SetFilter;
// Translation to use. If none, take first language. After reading it will contain the used translation.
property Translation : String read FTranslation Write SetTranslation;
// If set to true, if the detected language is not found, an exception is raised.
Property TranslationOnly : Boolean Read FTranslationOnly Write SetTranslationOnly;
end;
EVersionInfo = Class(Exception);
{ Convenience functions }
TVersionQuad = Array[1..4] of Word; // Array version
TProgramVersion = Record
Major,Minor,Revision,Build : Word; // Record version
end;
// Compare result.
TVersionCompare = (vcEqual, // Equal version
vcBuildDiffers, // Build differs version
vcRevisionDiffers, // At least revision differs
vcMinorDiffers, // At least Minor version differs
vcMajorDiffers // At least Major version differs
);
// Extract program version information in 1 call.
Function GetProgramVersion (Var Version : TVersionQuad) : Boolean;
Function GetProgramVersion (Var Version : TProgramVersion) : Boolean;
// Compare 2 versions
Function CompareVersionQuads(Quad1,Quad2 : TVersionQuad) : TVersionCompare;
Function CompareProgramVersion(Version1,Version2 : TProgramVersion) : TVersionCompare;
// Convert version quad to string
Function VersionQuadToStr(Const Quad : TVersionQuad) : String;
Function ProgramversionToStr(Const Version : TProgramVersion) : String;
// Try to convert string to version quad.
Function TryStrToVersionQuad(S : String; Var Quad : TVersionQuad) : Boolean;
Function TryStrToProgramVersion(S : String; Var Version : TProgramVersion) : Boolean;
// Convert string to version quad, raise exception if invalid string.
Function StrToVersionQuad(Const S : String) : TVersionQuad;
Function StrToProgramVersion(Const S : String ): TProgramVersion;
// Check if a version is newer than another. Maybe convert to operators ?
Function NewerVersion(Q1,Q2 : TVersionQuad) : Boolean;
Function NewerVersion(V1,V2 : TProgramVersion) : Boolean;
Function NewerVersion(V1,V2 : String) : Boolean;
Operator := (q : TVersionQuad) : TProgramVersion;
Operator := (V : TProgramVersion) : TVersionQuad;
implementation
Resourcestring
SErrNoResourcesLoaded = 'No version info loaded';
SErrNoTranslation = 'Translation "%s" not found in version strings.';
SErrNotVersionQuad = 'Quadruple "%s" is not a valid version';
{ TVersionInfo }
function TVersionInfo.GetFixedInfo: TVersionFixedInfo;
begin
CheckLoaded;
Result:=FVersionInfo.FixedInfo;
end;
Procedure TVersionInfo.CheckLoaded;
begin
if (FVersionInfo=Nil) then
Raise EVersionInfo.Create(SErrNoResourcesLoaded);
end;
function TVersionInfo.GetStringFileInfo: TVersionStringFileInfo;
begin
CheckLoaded;
Result := FVersionInfo.StringFileInfo;
end;
function TVersionInfo.GetVarFileInfo: TVersionVarFileInfo;
begin
CheckLoaded;
Result := FVersionInfo.VarFileInfo;
end;
constructor TVersionInfo.Create;
begin
inherited Create;
end;
destructor TVersionInfo.Destroy;
begin
FreeResources;
inherited Destroy;
end;
procedure TVersionInfo.FreeResources;
begin
if Assigned(FResources) then
FreeAndNil(FResources)
else
FreeAndNil(FVersionInfo);
end;
procedure TVersionInfo.Load(Const AFileName : String);
Var
I : Integer;
begin
FreeResources;
FResources:=TResources.Create;
FResources.LoadFromFile(AFileName);
I:=0;
While (FVersionInfo=Nil) and (I<FResources.Count) do
begin
if FResources.Items[i] is TVersionResource then
FVersionInfo:=TVersionResource(FResources.Items[i]);
Inc(I);
end;
// This will read the info.
FVersionInfo.FixedInfo;
end;
procedure TVersionInfo.Load(Const Instance: THandle);
var
Stream: TResourceStream;
begin
FreeResources;
Stream := TResourceStream.CreateFromID(Instance, 1, PChar(RT_VERSION));
try
FVersionInfo:=TVersionResource.Create;
FVersionInfo.SetCustomRawDataStream(Stream);
// access some property to load from the stream
FVersionInfo.FixedInfo;
// clear the stream
FVersionInfo.SetCustomRawDataStream(nil);
finally
Stream.Free;
end;
end;
{ initialize everything }
constructor TFileVersionInfo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FVersionStrings := TStringList.Create;
TStringList(FVersionStrings).Duplicates:=dupIgnore;
FFilter:=TStringList.Create;
TStringList(FFilter).Duplicates:= dupIgnore;
TStringList(FFilter).OnChange:=@FilterChange;
FFileName := '';
end;
destructor TFileVersionInfo.Destroy;
begin
FreeAndNil(FVersionStrings);
FreeAndNil(FFilter);
inherited;
end;
procedure TFileVersionInfo.Loaded;
begin
CheckRead;
end;
{ Get filename, check if file exists and read info from file }
procedure TFileVersionInfo.SetFileName (Const AFileName : string);
begin
FVersionStrings.clear;
if FileExists(AFileName) or (AFileName='') then
begin
FFileName := FFileName;
CheckRead;
end;
end;
procedure TFileVersionInfo.SetEnabled(AValue: Boolean);
begin
if FEnabled=AValue then Exit;
FEnabled:=AValue;
CheckRead;
end;
{ read info from file }
procedure TFileVersionInfo.ReadFileInfo;
Var
VI : TVersionInfo;
ST : TVersionStringTable;
TI,I,J : Integer;
S: String;
begin
FEnabled:=True;
VI:=TVersionInfo.Create;
try
if (FileName<>'') and (FileName<>Paramstr(0)) then
VI.Load(FileName)
else
VI.Load(HInstance);
// If no Translation specified, then try to detect.
If (FTranslation='') then
begin
if (VI.VarFileInfo.Count>0) then
FTranslation:=Format('%.4x%.4x',[VI.VarFileInfo.Items[0].language,VI.VarFileInfo.Items[0].codepage]);
end;
if (FTranslation='') then
begin
// Take first language
Ti:=0;
if (VI.StringFileInfo.Count>0) then
FTranslation:=VI.StringFileInfo.Items[0].Name
end
else
begin
// Look for index of language
TI:=VI.StringFileInfo.Count-1;
While (TI>=0) and (CompareText(VI.StringFileInfo.Items[Ti].Name,FTranslation)<>0) do
Dec(Ti);
If (TI<0) then
begin
if FTranslationOnly then
Raise EVersionInfo.CreateFmt(SErrNoTranslation,[FTranslation]);
TI:=0;
FTranslation:=VI.StringFileInfo.Items[Ti].Name;
end;
end;
ST:=VI.StringFileInfo.Items[Ti];
for J:=0 to ST.Count-1 do
if (FFilter.Count=0) or (FFilter.IndexOf(ST.Keys[j])<>-1) then
FVersionStrings.Add(ST.Keys[j]+'='+ST.Values[j]);
finally
FreeAndNil(VI);
end;
end;
procedure TFileVersionInfo.SetFilter(AValue: TStrings);
begin
if FFilter=AValue then Exit;
FFilter.Assign(AValue);
CheckRead;
end;
procedure TFileVersionInfo.SetTranslation(AValue: String);
begin
if FTranslation=AValue then Exit;
FTranslation:=AValue;
CheckRead;
end;
procedure TFileVersionInfo.SetTranslationOnly(AValue: Boolean);
begin
if FTranslationOnly=AValue then Exit;
FTranslationOnly:=AValue;
CheckRead;
end;
procedure TFileVersionInfo.CheckRead;
begin
if Enabled and not (csLoading in ComponentState) then
ReadFileInfo;
end;
procedure TFileVersionInfo.FilterChange(Sender: TObject);
begin
CheckRead;
end;
{ Convenience function }
Function GetProgramVersion (Var Version : TVersionQuad) : Boolean;
Var
VI : TVersionInfo;
I : Integer;
begin
Result:=False;
VI:=TVersionInfo.Create;
try
try
VI.Load(HInstance);
For I:=1 to 4 do
Version[i]:=VI.FixedInfo.FileVersion[I-1];
Result:=True;
except
// Ignore
end;
finally
VI.Free;
end;
end;
Function GetProgramVersion (Var Version : TProgramVersion) : Boolean;
Var
VQ : TVersionQuad;
begin
Result:=GetProgramVersion(VQ);
if Result then
Version:=VQ;
end;
Function CompareVersionQuads(Quad1,Quad2 : TVersionQuad) : TVersionCompare;
Const
EqualResults : Array[1..4] of TVersionCompare =
(vcMajorDiffers,vcMinorDiffers,vcRevisionDiffers,vcBuildDiffers);
Var
I : Integer;
begin
Result:=vcEqual;
I:=1;
While (Result=vcEqual) and (I<5) do
If Quad1[i]<>Quad2[i] then
Result:=EqualResults[i]
else
inc(I);
end;
Function CompareProgramVersion(Version1,Version2 : TProgramVersion) : TVersionCompare;
Var
Q1,Q2 : TVersionQuad;
begin
Q1:=Version1;
Q2:=Version2;
Result:=CompareVersionQuads(Q1,Q2);
end;
function PadVersion(const S: String): String;
Var
I,Dots : Integer;
begin
Dots:=0;
For i:=1 to length(S) do
if S[i]='.' then
Inc(Dots);
Result:=S;
while (Dots<3) do
begin
Result:=result+'.0';
Inc(Dots);
end;
end;
function VersionQuadToStr(const Quad: TVersionQuad): String;
begin
Result:=Format('%d.%d.%d.%d',[Quad[1],Quad[2],Quad[3],Quad[4]]);
end;
Function ProgramversionToStr(Const Version : TProgramVersion) : String;
begin
Result:=Format('%d.%d.%d.%d',[Version.Major,Version.Minor,Version.Revision,Version.Build]);
end;
Function TryStrToProgramVersion(S : String; Var Version : TProgramVersion) : Boolean;
Var
Q : TVersionQuad;
begin
Result:=TryStrToVersionQuad(S,Q);
if Result then
Version:=Q;
end;
Function TryStrToVersionQuad(S : String; Var Quad : TVersionQuad) : Boolean;
Var
I,P,Dots,Q : Integer;
begin
Result:=True;
FillChar(Quad,SizeOf(Quad),0);
Dots:=0;
I:=0;
While Result and (S<>'') and (I<4) do
begin
inc(i);
P:=Pos('.',S);
If (P=0) then
P:=Length(S)+1
else
inc(Dots);
Q:=StrToIntDef(Copy(S,1,P-1),-1);
Delete(S,1,P);
Result:=Q<>-1;
If Result then
Quad[I]:=Q;
end;
Result:=(Dots=3);
end;
Function StrToVersionQuad(Const S : String) : TVersionQuad;
begin
if Not TryStrToVersionQuad(S,Result) then
Raise EConvertError.CreateFmt(SErrNotVersionQuad,[S]);
end;
Function StrToProgramVersion(Const S : String ): TProgramVersion;
begin
Result:=StrToVersionQuad(S);
end;
Function NewerVersion(V1,V2 : TProgramVersion) : Boolean;
Var
Q1,Q2 : TversionQuad;
begin
Q1:=V1;
Q2:=V2;
Result:=Newerversion(Q1,Q2);
end;
Function NewerVersion(Q1,Q2 : TVersionQuad) : Boolean;
begin
Result:=False;
Case CompareVersionQuads(Q1,Q2) of
vcEqual : Result:=False;
vcBuildDiffers : Result:=Q1[4]>Q2[4];
vcRevisionDiffers : Result:=Q1[3]>Q2[3];
vcMinorDiffers : Result:=Q1[2]>Q2[2];
vcMajorDiffers : Result:=Q1[1]>Q2[1];
end;
end;
function NewerVersion(V1, V2: String): Boolean;
Var
Q1,Q2 : TVersionQuad;
begin
if TryStrToVersionQuad(V1,Q1) and TryStrToVersionQuad(V2,Q2) then
Result:=NewerVersion(Q1,Q2)
else
Result:=False;
end;
Operator := (q : TVersionQuad) : TProgramVersion;
begin
Result.Major:=Q[1];
Result.Minor:=Q[2];
Result.Revision:=Q[3];
Result.Build:=Q[4];
end;
Operator := (V : TProgramVersion) : TVersionQuad;
begin
Result[1]:=V.Major;
Result[2]:=V.Minor;
Result[3]:=V.Revision;
Result[4]:=V.Build;
end;
end.

238
packages/fcl-base/src/win/fileinfo.pp
View File

@ -1,238 +0,0 @@
{
This file is part of the Free Component Library (FCL)
Copyright (c) 1999-2000 by 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.
**********************************************************************}
{
Based on getver by Bernd Juergens - Munich, Germany
email :bernd@promedico.com
reworked by Stoian Ivanov (sdr@mail.bg)
Added ExtraVersionStrings,TryHardcodedTrans.
Using VersionCategories.Objects as TransID storage,
which is used later by getVersionSetting
Usage : Drop component on form. Set desired file name using
FileVersionInfo.filename := 'c:\winnt\system32\comctl32.dll'
or something like that.
Read StringLists VersionStrings and VersionCategories.
or check a single entry:
FileVersionInfo1.fileName := 'd:\winnt\system32\comctl32.dll';
showMessage(FileVersionInfo1.getVersionSetting('ProductVersion'));
}
unit fileinfo;
{$mode objfpc}
{$h+}
interface
uses
Windows, SysUtils, Classes;
{ Record to receive charset }
type TTranslation = record
case byte of
1: (langID,charset : WORD);
2: (transid:Dword);
end;
PTranslation=^TTranslation;
type
{ TFileVersionInfo }
TFileVersionInfo = class(TComponent)
private
FFileName : String;
FmyVersionStrings : TStringList;
FmyVersionCategories : TStringList;
FmyExtraVersionStrings :TStringList;
FmyTryHardcodedTrans :TStringList;
procedure SetFileName (Const inp : string);
procedure readVersionFromFile;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure AddExtraVersionString (Const extrafield:string);
procedure AddTryHardcodedTrans (Const hardtrans:string);
function getVersionSetting(Const inp : string; transid:dword=0): String;
published
property fileName : string read FFileName write SetFileName;
property VersionStrings : TStringList read FmyVersionStrings;
property VersionCategories : TStringList read FmyVersionCategories;
property ExtraVersionStrings : TStringList read FmyExtraVersionStrings;
property TryHardcodedTrans :TStringList read FmyTryHardcodedTrans;
end;
implementation
{ initialize everything }
constructor TFileVersionInfo.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FmyVersionStrings := TStringList.Create;
FmyVersionStrings.Duplicates:=dupAccept;
FmyVersionCategories := TStringList.Create;
FmyVersionCategories.Duplicates:=dupAccept;
FmyExtraVersionStrings := TStringList.Create;
FmyExtraVersionStrings.Duplicates:= dupIgnore;
FmyTryHardcodedTrans:=TStringList.Create;
FmyTryHardcodedTrans.Duplicates:=dupIgnore;
FFileName := '';
end;
destructor TFileVersionInfo.Destroy;
begin
FmyVersionCategories.Free;
FmyVersionStrings.Free;
FmyExtraVersionStrings.Free;
FmyTryHardcodedTrans.free;
inherited;
end;
{if you need other version strings extracted you add them here}
procedure TFileVersionInfo.AddExtraVersionString(Const extrafield: string);
begin
FmyExtraVersionStrings.add (extrafield);
end;
{some broken DLLs report wrong translations and you need to try some hardcoded transes
like NPSWF32.dll reports 040904b0(English/Unicode) but they are actualy 040904E4 (English/Latin1)}
procedure TFileVersionInfo.AddTryHardcodedTrans(Const hardtrans: string);
begin
FmyTryHardcodedTrans.add(hardtrans);
end;
{ Get filename, check if file exists and read info from file }
procedure TFileVersionInfo.SetFileName (Const inp : string);
begin
FmyVersionStrings.clear;
FmyVersionCategories.clear;
if FileExists(inp) then
begin
FFileName := inp;
readVersionFromFile;
end
else
FFileName := '';
end;
{ read info from file }
procedure TFileVersionInfo.readVersionFromFile;
var
struSize : Dword;
dwBytes : Dword;
dwTransBytes:Dword;
vi : pointer;
ti,i,hti : integer;
pp : pointer;
theTrans : PTranslation;
s : string;
ts : TStringList;
transstr:String;
//s_w : Widestring; //urf or not really does not matter
begin
ts := TStringList.Create;
try
ts.Assign(FmyExtraVersionStrings);
ts.add('Comments');
ts.add('CompanyName');
ts.add('FileDescription');
ts.add('FileVersion');
ts.add('InternalName');
ts.add('LegalCopyright');
ts.add('OriginalFilename');
ts.add('ProductName');
ts.add('ProductVersion');
struSize := GetFileVersionInfoSize(Pchar(FFileName),nil);
if struSize=0 then exit;
vi := NIL;
{ get memory }
GetMem(vi,struSize+10);
try
if (vi=nil) then
exit;
{ get data }
if not GetFileVersionInfo(PChar(FFileName),0,struSize,vi) then
exit;
{ get translation info }
if not VerQueryValue(vi,'\VarFileInfo\Translation',theTrans,dwTransBytes) then
exit;
while (dwTransBytes>=sizeof(TTranslation)) do
begin
transstr:=inttohex(theTrans^.langID,4)+inttohex(theTrans^.charset,4);
{ iterate over defined items }
for i:=0 to ts.count-1 do
begin
s:='\StringFileInfo\'+transstr+'\'+ts[i]+#0;
if not VerQueryValue(vi,@s[1],pp,dwBytes) then continue;
if dwBytes>0 then
begin
SetLength(s,dwBytes-1);
move(pp^,s[1],dwBytes-1);
FmyVersionCategories.AddObject(LowerCase(ts[i]),TObject(pointer(theTrans^.transid)));
FmyVersionStrings.add(s);
end
end;
inc (theTrans);
dec (dwTransBytes,sizeof(TTranslation));
end;
{Now with the dirty hardcoded hack}
for hti:=0 to FmyTryHardcodedTrans.Count-1 do
begin
transstr:=FmyTryHardcodedTrans[hti];
for i:=0 to ts.count-1 do
begin
s := '\StringFileInfo\'+transstr+'\'+ts[i]+#0;
if VerQueryValue(vi,@s[1],pp,dwBytes) and (dwbytes>0) then
begin
SetLength(s,dwBytes-1);
move(pp^,s[1],dwBytes-1);
FmyVersionCategories.AddObject(LowerCase(ts[i]),TObject(pointer(theTrans^.transid)));
FmyVersionStrings.add(s);
end
end;
end;
finally
FreeMem(vi);
end;
Finally
ts.Free
end;
end;
{ get single version string }
function TFileVersionInfo.getVersionSetting(Const inp : string; transid:dword=0): String;
var
i : integer;
s,v : string;
begin
s:=LowerCase(inp);
I:=0;
Result:='';
While (Result='') and (i<FmyVersionCategories.Count) do
begin
V:=FmyVersionCategories[i];
if (V=S) and ((transid=0) or (transid=dword(pointer(FmyVersionCategories.Objects[i])))) then
Result:=FmyVersionStrings[i];
inc(I);
end;
end;
end.