Description : contient des déclarations complémentaires à l'unité Windows de DELPHI et
des méthodes encapsulant les méthodes Windows suivantes pour une utilisation directe dans DELPHI :
// créer LorenJo
function If_FamilleNT: boolean;
function WindowVersion : LRJ_TWinVer;
function LRJ_GetSystemDirPath: string; // Style : C:\WINNT\ ou WINDOWS\SYSTEM32\
function LRJ_GetWindowsDirPath: string; // Style : C:\WINNT\ ou WINDOWS\
procedure LRJ_ShowMessage(const AMsg, ATitle: string; const AHandleParent : HWND = 0); overload;
procedure LRJ_ShowMessage(const AMsg: string); overload;
function LRJ_ShowMessageSpecial(const AMsg, ATitle: string; const AHandleParent : HWND; const AType: UINT): integer;
procedure LRJ_ShowMessageLastErrorString;
//Pour LRJ_MessageDlg, regarder la doc MSDN sur la function MessageBox, notamment pour le result
function LRJ_MessageDlg(const AMsg, ATitle: string; const AComposedInfoBtons: UINT; const AHandleParent : HWND = 0): Integer;
function LRJ_CTL_CODE(ADeviceType,AFunction,AMethod,AAccess: integer): integer;
function LRJ_ExtractExtension(const AFileName: string): string;
function LRJ_StringToNonNilOleStr(AString: string): PWideChar;
function LRJ_GetTypeBoot: LRJ_TypeBoot;
// méthodes déclarées plus bas
//function LRJ_DllGetVersion(ADLLName: string): DLLVERSIONINFO;
//function LRJ_FileGetTypedInfo(const AFileName: string; ATypedInfo: LrJ_TTypedFileInfo): string;
// surcharge la méthode originale de l'unité Windows de Delphi, renvoie directement des string
function LRJ_GetModuleFileName: string;
function LRJ_ExpandEnvironmentStrings(const APath: string): string;
function LRJ_GetComputerName: string;
function LRJ_GetWindowsDirectory: string; // Style : C:\WINNT ou WINDOWS
function LRJ_GetSystemDirectory: string; // Style : C:\WINNT ou WINDOWS\SYSTEM32
function LRJ_GetKeyNameText(AKey: UINT): string; // on entre keycode et on ressort un libellé
function LRJ_GetUserName: string;
function LRJ_GetLastErrorString: string;
function LRJ_GetErrorString(ErrorCode: DWORD): string;
function LRJ_GlobalGetAtomName(AAtom: ATOM): string;
function LRJ_LoadLibrary(const AFileName: string): HMODULE;
function LRJ_GetShortPathName(const ALongPathName: string): string;
function LRJ_GetFullPathName(const APathName: string): string;
function LRJ_GetClassName(const AHWND: HWND): string;
function LRJ_GetLongPathName(const AShortPathName: string): string;
const
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- Message d'erreur LorenJo --------------------------
//--------------------------------------------------------------------------------------------------------------------
LRJ_Msg_Function_Not_Loaded = DWORD(-1) - 1;
// Valeur texte
LRJ_MsgText_Function_Not_Loaded = 'La function n''a pas pu être chargée';
//--------------------------------------------------------------------------------------------------------------------
//----------------------------------------------nom de classe de la barre des tâches --------------------------
//--------------------------------------------------------------------------------------------------------------------
LRJ_Shell_TrayWnd_Name = 'Shell_TrayWnd';
//--------------------------------------------------------------------------------------------------------------------
//----------------------------------------------Access Rights Pour Thread --------------------------
//--------------------------------------------------------------------------------------------------------------------
// tiré de winnt.h
LRJ_THREAD_TERMINATE = $0001;
LRJ_THREAD_SUSPEND_RESUME = $0002;
LRJ_THREAD_GET_CONTEXT = $0008;
LRJ_THREAD_SET_CONTEXT = $0010;
LRJ_THREAD_SET_INFORMATION = $0020;
LRJ_THREAD_QUERY_INFORMATION = $0040;
LRJ_THREAD_SET_THREAD_TOKEN = $0080;
LRJ_THREAD_IMPERSONATE = $0100;
LRJ_THREAD_DIRECT_IMPERSONATION = $0200;
LRJ_FILE_AllSpecificRights = LRJ_FILE_READ_DATA or LRJ_FILE_WRITE_DATA or LRJ_FILE_APPEND_DATA or LRJ_FILE_READ_EA or
LRJ_FILE_WRITE_EA or LRJ_FILE_EXECUTE or LRJ_FILE_READ_ATTRIBUTES or LRJ_FILE_WRITE_ATTRIBUTES;
LRJ_DIRECTORY_AllSpecificRights = LRJ_FILE_LIST_DIRECTORY or LRJ_FILE_ADD_FILE or LRJ_FILE_ADD_SUBDIRECTORY or LRJ_FILE_READ_EA or
LRJ_FILE_WRITE_EA or LRJ_FILE_TRAVERSE or LRJ_FILE_DELETE_CHILD or LRJ_FILE_READ_ATTRIBUTES or
LRJ_FILE_WRITE_ATTRIBUTES;
LRJ_FILE_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or LRJ_FILE_AllSpecificRights;
LRJ_FILE_GENERIC_READ = STANDARD_RIGHTS_READ or
LRJ_FILE_READ_DATA or
LRJ_FILE_READ_ATTRIBUTES or
LRJ_FILE_READ_EA or
SYNCHRONIZE;
LRJ_FILE_GENERIC_WRITE = STANDARD_RIGHTS_WRITE or
LRJ_FILE_WRITE_DATA or
LRJ_FILE_WRITE_ATTRIBUTES or
LRJ_FILE_WRITE_EA or
LRJ_FILE_APPEND_DATA or
SYNCHRONIZE;
LRJ_FILE_GENERIC_EXECUTE = STANDARD_RIGHTS_EXECUTE or
LRJ_FILE_READ_ATTRIBUTES or
LRJ_FILE_EXECUTE or
SYNCHRONIZE;
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- file attributes --------------------------
//--------------------------------------------------------------------------------------------------------------------
const
FILE_DEVICE_FILE_SYSTEM = $00000009;
IO_COMPLETION_MODIFY_STATE = $0002;
IO_COMPLETION_ALL_ACCESS = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or 3;
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- MapVirtualKey types--------------------------
//--------------------------------------------------------------------------------------------------------------------
const
MAPVK_VK_TO_VSC = 0;
MAPVK_VSC_TO_VK = 1;
MAPVK_VK_TO_CHAR = 2;
MAPVK_VSC_TO_VK_EX = 3;
MAPVK_VK_TO_VSC_EX = 4;
//--------------------------------------------------------------------------------------------------------------------
//----------------------------------------------Vitual key code --------------------------
//--------------------------------------------------------------------------------------------------------------------
// tiré de winnt.h
const
VK_BROWSER_BACK = $A6;
VK_BROWSER_FAVORITES = $AB;
VK_BROWSER_FORWARD = $A7;
VK_BROWSER_HOME = $AC;
VK_BROWSER_REFRESH = $A8;
VK_BROWSER_SEARCH = $AA;
VK_BROWSER_STOP = $A9;
VK_LAUNCH_APP1 = $B6;
VK_LAUNCH_APP2 = $B7;
VK_LAUNCH_MAIL = $B4;
VK_LAUNCH_MEDIA_SELECT = $B5;
VK_MEDIA_NEXT_TRACK = $B0;
VK_MEDIA_PLAY_PAUSE = $B3;
VK_MEDIA_PREV_TRACK = $B1;
VK_MEDIA_STOP = $B2;
VK_VOLUME_DOWN = $AE;
VK_VOLUME_MUTE = $AD;
VK_VOLUME_UP = $AF;
VK_XBUTTON1 = $05;
VK_XBUTTON2 = $06;
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- File creation flags--------------------------
//--------------------------------------------------------------------------------------------------------------------
// File creation flags must start at the high end since they
// are combined with the attributes
//
FILE_FLAG_OPEN_REPARSE_POINT = $00200000;
FILE_FLAG_OPEN_NO_RECALL = $00100000;
FILE_FLAG_FIRST_PIPE_INSTANCE = $00080000;
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- Extended style window --------------------------
//--------------------------------------------------------------------------------------------------------------------
const
LRJ_WS_EX_COMPOSITED = $02000000;
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- control type --------------------------
//--------------------------------------------------------------------------------------------------------------------
const
LRJ_ODT_LISTVIEW = 102;
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- Environnement variables --------------------------
//--------------------------------------------------------------------------------------------------------------------
{
%ALLUSERSPROFILE% Local Returns the location of the All Users Profile.
%APPDATA% Local Returns the location where applications store data by default.
%CD% Local Returns the current directory string.
%CMDCMDLINE% Local Returns the exact command line used to start the current Cmd.exe.
%CMDEXTVERSION% System Returns the version number of the current Command Processor Extensions.
%COMPUTERNAME% System Returns the name of the computer.
%COMSPEC% System Returns the exact path to the command shell executable.
%DATE% System Returns the current date. Uses the same format as the date /t command. Generated by Cmd.exe. For more information about the date command, see Date.
%ERRORLEVEL% System Returns the error code of the most recently used command. A non zero value usually indicates an error.
%HOMEDRIVE% System Returns which local workstation drive letter is connected to the user's home directory. Set based on the value of the home directory. The user's home directory is specified in Local Users and Groups.
%HOMEPATH% System Returns the full path of the user's home directory. Set based on the value of the home directory. The user's home directory is specified in Local Users and Groups.
%HOMESHARE% System Returns the network path to the user's shared home directory. Set based on the value of the home directory. The user's home directory is specified in Local Users and Groups.
%LOGONSERVER% Local Returns the name of the domain controller that validated the current logon session.
%NUMBER_OF_PROCESSORS% System Specifies the number of processors installed on the computer.
%OS% System Returns the operating system name. Windows 2000 displays the operating system as Windows_NT.
%PATH% System Specifies the search path for executable files.
%PATHEXT% System Returns a list of the file extensions that the operating system considers to be executable.
%PROCESSOR_ARCHITECTURE% System Returns the chip architecture of the processor. Values: x86 x86
Refers to microprocessors that have or emulate the 32-bit Intel processor architecture.or IA64 (Itanium Itanium
An Intel microprocessor that uses explicitly parallel instruction set computing and 64-bit memory addressing.
Itanium-based refers to systems or platforms that are based on the Itanium processor. Itanium 2-based refers to systems or platforms that are based on the Itanium 2 processor. Itanium architecture-based refers to systems or platforms that are based on the Itanium and Itanium 2 processors.
-based).
%PROCESSOR_IDENTFIER% System Returns a description of the processor.
%PROCESSOR_LEVEL% System Returns the model number of the processor installed on the computer.
%PROCESSOR_REVISION% System Returns the revision number of the processor.
%PROMPT% Local Returns the command prompt settings for the current interpreter. Generated by Cmd.exe.
%RANDOM% System Returns a random decimal number between 0 and 32767. Generated by Cmd.exe.
%SYSTEMDRIVE% System Returns the drive containing the Windows server operating system root directory (that is, the system root).
%SYSTEMROOT% System Returns the location of the Windows server operating system root directory.
%TEMP% and %TMP% System and User Returns the default temporary directories that are used by applications available to users who are currently logged on. Some applications require TEMP and others require TMP.
%TIME% System Returns the current time. Uses the same format as the time /t command. Generated by Cmd.exe. For more information about the time command, see Time.
%USERDOMAIN% Local Returns the name of the domain that contains the user's account.
%USERNAME% Local Returns the name of the user who is currently logged on.
%USERPROFILE% Local Returns the location of the profile for the current user.
%WINDIR% System Returns the location of the operating system directory
}
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- Structure shell version --------------------------
//--------------------------------------------------------------------------------------------------------------------
//tiré de shlwapi.h
type
DLLVERSIONINFO = packed record
cbSize: DWORD ;
dwMajorVersion: DWORD ;
dwMinorVersion: DWORD ;
dwBuildNumber: DWORD ;
dwPlatformID: DWORD ;
end;
DLLVERSIONINFO2 = packed record
info1: DLLVERSIONINFO ;
dwFlags: DWORD ;
//ullVersion: ULONGLONG ; - original
dwQFEVersion: WORD ; // repartition lorenjo
dwBuildNumber: WORD ; // repartition lorenjo
dwMinorVersion: WORD ; // repartition lorenjo
dwMajorVersion : WORD ; // repartition lorenjo
end;
DLLGETVERSIONPROC = function (var DllInfo: DLLVERSIONINFO2): HRESULT; stdcall;
function LRJ_DllGetVersion(ADLLName: string): DLLVERSIONINFO;
const
LRJ_ProcDllGetVersionName = 'DllGetVersion';
//--------------------------------------------------------------------------------------------------------------------
//----------------------------------------------additif delphi 5 to 6 --------------------------
//--------------------------------------------------------------------------------------------------------------------
// Compléte les déclarations pour delphi 5
//WS_EX_LAYERED = $00080000;
//WS_EX_NOINHERITLAYOUT = $00100000; // Disable inheritence of mirroring by children
//WS_EX_LAYOUTRTL = $00400000; // Right to left mirroring
//WS_EX_NOACTIVATE = $08000000;
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- complète l'unité Messages --------------------------
//--------------------------------------------------------------------------------------------------------------------
WM_SYNCPAINT = $0088;
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- RegisterShellHook types --------------------------
//--------------------------------------------------------------------------------------------------------------------
const
RSH_DEREGISTER = 0;
RSH_REGISTER = 1;
RSH_REGISTER_PROGMAN = 2;
RSH_REGISTER_TASKMAN = 3;
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- String Lengths for various LanMan names --------------------------
//--------------------------------------------------------------------------------------------------------------------
const
CNLEN = 15; // Computer name length
LM20_CNLEN = 15; // LM 2.0 Computer name length
DNLEN = CNLEN; // Maximum domain name length
LM20_DNLEN = LM20_CNLEN; // LM 2.0 Maximum domain name length
UNCLEN = CNLEN+2; // UNC computer name length
LM20_UNCLEN = LM20_CNLEN+2; // LM 2.0 UNC computer name length
NNLEN = 80; // Net name length (share name)
LM20_NNLEN = 12; // LM 2.0 Net name length
RMLEN = UNCLEN+1+NNLEN; // Max remote name length
LM20_RMLEN = LM20_UNCLEN+1+LM20_NNLEN; // LM 2.0 Max remote name length
SNLEN = 80; // Service name length
LM20_SNLEN = 15; // LM 2.0 Service name length
STXTLEN = 256; // Service text length
LM20_STXTLEN = 63; // LM 2.0 Service text length
PATHLEN = 256; // Max. path (not including drive name)
LM20_PATHLEN = 256; // LM 2.0 Max. path
DEVLEN = 80; // Device name length
LM20_DEVLEN = 8; // LM 2.0 Device name length
EVLEN = 16; // Event name length
//--------------------------------------------------------------------------------------------------------------------
//---------------------------------------------- User, Group and Password lengths --------------------------
//--------------------------------------------------------------------------------------------------------------------
UNLEN = 256; // Maximum user name length
LM20_UNLEN = 20; // LM 2.0 Maximum user name length
GNLEN = UNLEN; // Group name
LM20_GNLEN = LM20_UNLEN ; // LM 2.0 Group name
PWLEN = 256; // Maximum password length
LM20_PWLEN = 14; // LM 2.0 Maximum password length
SHPWLEN = 8; // Share password length (bytes)
CLTYPE_LEN = 12; // Length of client type string
MAXCOMMENTSZ = 256; // Multipurpose comment length
LM20_MAXCOMMENTSZ = 48; // LM 2.0 Multipurpose comment length
QNLEN = NNLEN; // Queue name maximum length
LM20_QNLEN = LM20_NNLEN; // LM 2.0 Queue name maximum length
//--------------------------------------------------------------------------------------------------------------------
//----------------------------------------------fin --------------------------
//--------------------------------------------------------------------------------------------------------------------
implementation
{--------------------------------------------------------------}
procedure LRJ_ShowMessageLastErrorString;
begin
LRJ_ShowMessage(LRJ_GetLastErrorString);
end;
{--------------------------------------------------------------}
function LRJ_StringToNonNilOleStr(AString: string): PWideChar;
begin
result := StringToOleStr(AString);
if result = nil then result := '';
end;
{--------------------------------------------------------------}
function LRJ_GetTypeBoot: LRJ_TypeBoot;
begin
result := tBoot_Unknow;
case GetSystemMetrics(SM_CLEANBOOT) of
0 : result := tboot_Normal;
1 : result := tboot_FailSafe;
2 : result := tboot_FailSafeNetW;
end;
end;
{--------------------------------------------------------------}
function LRJ_GetKeyNameText(AKey: UINT): string;
var
zBuf:array[0..256] of char;
zMap: UINT;
zLength: integer;
begin
zMap := MapVirtualKeyEx(AKey,0,GetKeyboardLayout(0)) shl 16;
zLength := GetKeyNameText(zMap,zBuf,sizeof(zBuf));
if zLength > 0 then
begin
SetLength(result , zLength);
StrMove(PChar(result), zBuf, zLength);
end
else
result:= 'Value = '+ IntToStr(AKey);
end;
{--------------------------------------------------------------}
function LRJ_ShowMessageSpecial(const AMsg, ATitle: string; const AHandleParent : HWND; const AType: UINT): integer;
begin
result := MessageBox(AHandleParent, PChar(AMsg), PChar(ATitle), AType);
end;
{--------------------------------------------------------------}
function LRJ_GetClassName(const AHWND: HWND): string;
var
zBuf: array[0..256] of char;
zLength: integer;
begin
FillChar(zBuf, SizeOf(zBuf), 0);
zLength := GetClassName(AHWND, @zBuf, SizeOf(zBuf));
if zLength > 0 then
begin
SetLength(result , zLength);
StrMove(PChar(result), zBuf, zLength);
end
else
result := '';
end;
{--------------------------------------------------------------}
function LRJ_ExtractExtension(const AFileName: string): string;
var
zPos: integer;
begin
result := AFileName;
if AFileName <> '' then
begin
result := ExtractFileExt(AFileName);
if length(result) > 1 then
result := copy(result,2, length(result)-1);
if length(result) > 0 then
result := AnsiLowerCase(Result);
zPos := pos('"', Result);
if zPos > 0 then
begin
if zPos = 1 then
Result := copy(Result, 2, length(Result) - 1)
else
Result := copy(Result, 1, zPos-1);
end;
Result := AnsiLowerCase(Result);
if (Result = '.') or (Result = ' ') then Result := '';
end;
end;
{--------------------------------------------------------------}
function LRJ_CTL_CODE(ADeviceType,AFunction,AMethod,AAccess: integer): integer;
begin
Result := (ADeviceType shl 16) or (AAccess shl 14) or (AFunction shl 2) or AMethod;
end;
{--------------------------------------------------------------}
function LRJ_GetFullPathName(const APathName: string): string;
var
zBuf: array of Widechar;
zLength: integer;
zPWChar: PWideChar;
zPathNameU: WideString;
begin
zPathNameU := APathName; //contrairement à ce qui est prétendu dans la doc, ca marche correctement que si on ne met pas '\\?\'
zLength := GetFullPathNameW(PWideChar(zPathNameU), 0, PWideChar(zBuf), zPWChar);
if zLength > 0 then
begin
SetLength(zBuf, zLength + 0);
zLength := GetFullPathNameW(PWideChar(zPathNameU), zLength, PWideChar(zBuf), zPWChar);
if zLength > 0 then
begin
result := PWideChar(zBuf);
end
else result := '';
end
else result := '';
end;
{--------------------------------------------------------------}
function LRJ_GetLongPathName(const AShortPathName: string): string;
type
TGetLongPathName = function (lpszLongPath: PChar; lpszShortPath: PChar;
cchBuffer: DWORD): DWORD; stdcall;
var
zBuf: array of char;
zLength: integer;
zProc: TGetLongPathName;
zModule: HModule;
begin
result := '';
zModule := LRJ_LoadLibrary(kernel32);
if zModule > 0 then
begin
zProc := GetProcAddress(zModule,'GetLongPathNameA');
if assigned(zProc) then
begin
zLength := zProc(PChar(AShortPathName), nil, 0);
if zLength > 0 then
begin
SetLength(zBuf, zLength);
zLength := zProc(PChar(AShortPathName), PChar(zBuf), zLength);
if zLength > 0 then
begin
SetLength(result , zLength);
StrMove(PChar(result), PChar(zBuf), zLength);
end
else result := '';
end
else result := '';
end;
FreeLibrary(zModule);
end;
if result = '' then result := AShortPathName;
end;
{--------------------------------------------------------------}
function LRJ_GetShortPathName(const ALongPathName: string): string;
var
zBuf: array of char;
zLength: integer;
begin
zLength := GetShortPathName(PChar(ALongPathName), nil, 0);
if zLength > 0 then
begin
SetLength(zBuf, zLength);
zLength := GetShortPathName(PChar(ALongPathName), PChar(zBuf), zLength);
if zLength > 0 then
begin
SetLength(result , zLength);
StrMove(PChar(result), PChar(zBuf), zLength);
end
else result := '';
end
else result := '';
end;
{--------------------------------------------------------------}
function LRJ_MessageDlg(const AMsg, ATitle: string; const AComposedInfoBtons: UINT; const AHandleParent : HWND = 0): Integer;
begin
result := MessageBox(AHandleParent, PChar(AMsg), PChar(ATitle), AComposedInfoBtons);
end;
{--------------------------------------------------------------}
procedure LRJ_ShowMessage(const AMsg: string);
begin
MessageBox(0, PChar(AMsg), PChar('') , MB_OK);
end;
{--------------------------------------------------------------}
procedure LRJ_ShowMessage(const AMsg, ATitle: string; const AHandleParent : HWND = 0);
begin
MessageBox(AHandleParent, PChar(AMsg), PChar(ATitle), MB_OK);
end;
{--------------------------------------------------------------}
function LRJ_GetWindowsDirPath: string;
begin
result := LRJ_GetWindowsDirectory + '\';
end;
{--------------------------------------------------------------}
function LRJ_GetSystemDirPath: string;
begin
result := LRJ_GetSystemDirectory + '\';
end;
{--------------------------------------------------------------}
function LRJ_LoadLibrary(const AFileName: string): HMODULE;
begin
result := LoadLibrary(PChar(AFileName));
if result <= HINSTANCE_ERROR then result := 0;
end;
{--------------------------------------------------------------}
function LRJ_GlobalGetAtomName(AAtom: ATOM): string;
var
zBuf: array[0..255] of char;
zLength: integer;
begin
FillChar(zBuf, SizeOf(zBuf), 0);
zLength := GlobalGetAtomName(AAtom, zBuf, SizeOf(zBuf));
if zLength > 0 then
begin
SetLength(result , zLength);
StrMove(PChar(result), zBuf, zLength);
end
else
result := 'Error';
end;
{--------------------------------------------------------------}
function LRJ_GetLastErrorString: string;
begin
result := LRJ_GetErrorString(GetLastError);
end;
{--------------------------------------------------------------}
function LRJ_GetErrorString(ErrorCode: DWORD): string;
var
zBuf: pointer;
zSize: integer;
begin
case ErrorCode of
LRJ_Msg_Function_Not_Loaded : result := LRJ_MsgText_Function_Not_Loaded;
else
begin
if ErrorCode = 0 then
result := 'Pas d''erreur : error code = 0'
else
begin
zSize := FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM or FORMAT_MESSAGE_ALLOCATE_BUFFER or FORMAT_MESSAGE_MAX_WIDTH_MASK,
nil, ErrorCode, LOCALE_USER_DEFAULT, @zBuf, 0, nil );
if zSize > 0 then
begin
SetLength(result , zSize-1);
StrMove(PChar(result), zBuf, zSize-1);
LocalFree(HLocal(zBuf));
end
else
result := 'Erreur : Ne parvient pas à obtenir le texte correspondant à l''erreur';
end;
end;
end;
end;
{--------------------------------------------------------------}
function LRJ_DllGetVersion(ADLLName: string): DLLVERSIONINFO;
var
zDll: HMODULE;
zProc: DLLGETVERSIONPROC;
zTest: DLLVERSIONINFO2;
begin
FillChar(result, SizeOf(result), 0);
FillChar(zTest, SizeOf(zTest), 0);
zTest.info1.cbSize := SizeOf(zTest);
zDll := LRJ_LoadLibrary(PChar(ADLLName));
if zDll > 0 then
begin
zProc := GetProcAddress(zDll, LRJ_ProcDllGetVersionName);
if assigned(zProc) then
if zProc(zTest) = NOERROR then
begin
result.dwMajorVersion := zTest.info1.dwMajorVersion;
result.dwMinorVersion := zTest.info1.dwMinorVersion;
result.dwBuildNumber := zTest.info1.dwBuildNumber;
result.dwPlatformID := zTest.info1.dwPlatformID;
end;
FreeLibrary(zDll);
end;
end;
{--------------------------------------------------------------}
function LRJ_GetSystemDirectory: string;
var
zBuf: array of char;
zLength: integer;
begin
zLength := GetSystemDirectory(nil, 0);
if zLength > 0 then
begin
SetLength(zBuf, zLength);
zLength := GetSystemDirectory(PChar(zBuf), zLength);
if zLength > 0 then
begin
SetLength(result , zLength);
StrMove(PChar(result), PChar(zBuf), zLength);
end
else result := '';
end
else result := '';
end;
{--------------------------------------------------------------}
function LRJ_GetWindowsDirectory: string;
var
zBuf: array of char;
zLength: integer;
begin
zLength := GetWindowsDirectory(nil, 0);
if zLength > 0 then
begin
SetLength(zBuf, zLength);
zLength := GetWindowsDirectory(PChar(zBuf), zLength);
if zLength > 0 then
begin
SetLength(result , zLength);
StrMove(PChar(result), PChar(zBuf), zLength);
end
else result := '';
end
else result := '';
end;
{--------------------------------------------------------------}
function LRJ_GetUserName: string;
var
zBuf: array of char;
zLength: DWORD;
begin
zLength := UNLEN + 1;
SetLength(zBuf, zLength);
if not GetUserName(PChar(zBuf), zLength) then
begin
if GetLastError = ERROR_INSUFFICIENT_BUFFER then
begin
SetLength(zBuf, zLength);
if not GetUserName(PChar(zBuf), zLength) then zLength := 0;
end;
end;
if zLength > 0 then
begin
SetLength(result , zLength-1);
StrMove(PChar(result), PChar(zBuf), zLength-1);
end
else result := '';
end;
{--------------------------------------------------------------}
function LRJ_GetComputerName: string;
var
zBuf: array of char;
zLength: DWORD;
begin
zLength := MAX_COMPUTERNAME_LENGTH + 1;
SetLength(zBuf, zLength);
if not GetComputerName(PChar(zBuf), zLength) then
begin
if GetLastError = ERROR_BUFFER_OVERFLOW then
begin
SetLength(zBuf, zLength);
if not GetComputerName(PChar(zBuf), zLength) then zLength := 0;
end;
end;
if zLength > 0 then
begin
SetLength(result , zLength);
StrMove(PChar(result), PChar(zBuf), zLength);
end
else result := '';
end;
{--------------------------------------------------------------}
function LRJ_ExpandEnvironmentStrings(const APath: string): string;
var
zBuf: array of char;
zLength: integer;
begin
zLength := ExpandEnvironmentStrings(PChar(APath), nil, 0);
if zLength > 0 then
begin
SetLength(zBuf, zLength);
zLength := ExpandEnvironmentStrings(PChar(APath), PChar(zBuf), zLength);
if zLength > 0 then
begin
SetLength(result , zLength-1);
StrMove(PChar(result), PChar(zBuf), zLength-1);
end
else result := APath;
end
else result := APath;
end;
{--------------------------------------------------------------}
function LRJ_GetModuleFileName: string;
var
zModName: array of char;
zLength: integer;
zSize: integer;
begin
zLength := 0;
zSize := zLength;
while(zSize = zLength) do
begin
zLength := zLength + MAX_PATH;
SetLength(zModName, zLength);
zSize := GetModuleFileName(HInstance, PChar(zModName), zLength);
end;
if zSize > 0 then
begin
SetLength(result , zSize);
StrMove(PChar(result), PChar(zModName), zSize);
end
else result := '';
end;
{--------------------------------------------------------------}
function WindowVersion : LRJ_TWinVer;
var
zInfoSysMS: OSVERSIONINFO;
begin
result := lrj_WvUnknow;
zInfoSysMS.dwOSVersionInfoSize := SizeOf(zInfoSysMS);
GetVersionEx(zInfoSysMS);
case zInfoSysMS.dwMajorVersion of
3 : result := lrj_WvNT35;
4 :
begin
if zInfoSysMS.dwPlatformId = VER_PLATFORM_WIN32_NT then
begin
result := lrj_WvNT4;
end
else
begin
case zInfoSysMS.dwMinorVersion of
0..9 : result := lrj_Wv95;
10..89 : result := lrj_Wv98;
90..1000 : result := lrj_WvME;
end;
end;
end;
5 :
begin
case zInfoSysMS.dwMinorVersion of
0 : result := lrj_Wv2000;
1 : result := lrj_WvXP;
2 : result := lrj_Wv2003Server;
else
result := lrj_Longhorn;
end;
end;
6 :
begin
result := lrj_Vista;
end;
7..1000 : result := lrj_WvNewWin;
end;
end;
{--------------------------------------------------------------}
function If_FamilleNT: boolean;
var
zInfoSysMS: OSVERSIONINFO;
begin
result := False;
zInfoSysMS.dwOSVersionInfoSize := SizeOf(zInfoSysMS);
GetVersionEx(zInfoSysMS);
case zInfoSysMS.dwPlatformId of
VER_PLATFORM_WIN32s : ;
VER_PLATFORM_WIN32_WINDOWS : ;
VER_PLATFORM_WIN32_NT : result := true;
end;
end;
{--------------------------------------------------------------}
{--------------------------------------------------------------}
{------------------- Fin -------------------------------------------}
{--------------------------------------------------------------}
{--------------------------------------------------------------}
end.
