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

* added some more of win32* delphi pseudo constants

Browse Source
This commit is contained in:
marco 2003-11-06 22:25:10 +00:00
parent ec6b640d6d
commit d3ca61aa15
1 changed files with 42 additions and 19 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
rtl/win32/sysutils.pp
View File

@ -48,6 +48,11 @@ type
Var
Win32Platform : Longint;
Win32MajorVersion,
Win32MinorVersion,
Win32BuildNumber : dword;
Win32CSDVersion : ShortString; // CSD record is 128 bytes only?
implementation
@ -669,9 +674,40 @@ end;
****************************************************************************}
var
versioninfo : TOSVERSIONINFO;
kernel32dll : THandle;
Procedure LoadVersionInfo;
// and getfreespaceex
Var
versioninfo : TOSVERSIONINFO;
i : Integer;
begin
kernel32dll:=0;
GetDiskFreeSpaceEx:=nil;
versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
GetVersionEx(versioninfo);
Win32Platform:=versionInfo.dwPlatformId;
Win32MajorVersion:=versionInfo.dwMajorVersion;
Win32MinorVersion:=versionInfo.dwMinorVersion;
Win32BuildNumber:=versionInfo.dwBuildNumber;
Move (versioninfo.szCSDVersion ,Win32CSDVersion[1],128);
win32CSDVersion[0]:=chr(strlen(pchar(@versioninfo.szCSDVersion)));
if ((versioninfo.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) and
(versioninfo.dwBuildNUmber>=1000)) or
(versioninfo.dwPlatformId=VER_PLATFORM_WIN32_NT) then
begin
kernel32dll:=LoadLibrary('kernel32');
if kernel32dll<>0 then
{$IFDEF VIRTUALPASCAL}
@GetDiskFreeSpaceEx:=GetProcAddress(0,'GetDiskFreeSpaceExA');
{$ELSE}
GetDiskFreeSpaceEx:=TGetDiskFreeSpaceEx(GetProcAddress(kernel32dll,'GetDiskFreeSpaceExA'));
{$ENDIF}
end;
end;
function FreeLibrary(hLibModule : THANDLE) : longbool;
stdcall;external 'kernel32' name 'FreeLibrary';
function GetVersionEx(var VersionInformation:TOSVERSIONINFO) : longbool;
@ -685,23 +721,7 @@ function GetProcAddress(hModule : THandle;lpProcName : pchar) : pointer;
Initialization
InitExceptions; { Initialize exceptions. OS independent }
InitInternational; { Initialize internationalization settings }
versioninfo.dwOSVersionInfoSize:=sizeof(versioninfo);
GetVersionEx(versioninfo);
kernel32dll:=0;
GetDiskFreeSpaceEx:=nil;
Win32Platform:=versionInfo.dwPlatformId;
if ((versioninfo.dwPlatformId=VER_PLATFORM_WIN32_WINDOWS) and
(versioninfo.dwBuildNUmber>=1000)) or
(versioninfo.dwPlatformId=VER_PLATFORM_WIN32_NT) then
begin
kernel32dll:=LoadLibrary('kernel32');
if kernel32dll<>0 then
{$IFDEF VIRTUALPASCAL}
@GetDiskFreeSpaceEx:=GetProcAddress(0,'GetDiskFreeSpaceExA');
{$ELSE}
GetDiskFreeSpaceEx:=TGetDiskFreeSpaceEx(GetProcAddress(kernel32dll,'GetDiskFreeSpaceExA'));
{$ENDIF}
end;
LoadVersionInfo;
Finalization
DoneExceptions;
@ -710,7 +730,10 @@ Finalization
end.
{
$Log$
Revision 1.25 2003-10-25 23:44:33 hajny
Revision 1.26 2003-11-06 22:25:10 marco
* added some more of win32* delphi pseudo constants
Revision 1.25 2003/10/25 23:44:33 hajny
* THandle in sysutils common using System.THandle
Revision 1.24 2003/09/17 15:06:36 peter