unit DBCheckU;
{$ifdef Ver80} { Delphi 1.0x }
{$define DelphiLessThan4}
{$endif}
{$ifdef Ver90} { Delphi 2.0x }
{$define DelphiLessThan4}
{$endif}
{$ifdef Ver100} { Delphi 3.0x }
{$define DelphiLessThan4}
{$endif}
interface
function CheckOKForParadoxAppToRun:boolean;
implementation
uses
{$ifdef Win32}
Registry,
{$else}
IniFiles,
{$endif}
DbiProcs, DbiTypes, DbiErrs,
DB, DBTables, Forms, SysUtils, Classes, Dialogs,
Winprocs, WinTypes;
const
RebootRequired: Boolean = False;
procedure CheckLocalShare;
var
ASYSConfig: SYSConfig;
begin
{$ifdef Win32}
{ Ensure BDE is initialised }
Session.Open;
{$endif}
if (DbiGetSysConfig(ASYSConfig) = DbiErr_None)
and
not ASYSConfig.bLocalShare
then
begin
ShowMessage('
BDE''
s LOCAL SHARE flag must be TRUE for this ' +
'
program to run. Ask your System Administrator to do this for ' +
'
you.'#13#13'
This program will not continue until this change ' +
'
has been made and all BDE applications have been restarted');
{$ifdef Win32}
Application.ShowMainForm := False;
{$endif}
Application.Terminate;
end
end;
{$ifdef Win32}
function RestartDialog(Wnd: HWnd; Reason: PChar; Flags: Integer): Integer;
stdcall;
external '
shell32.dll'
index 59;
type
TVersionNo =
record
MS, LS: Cardinal;
end;
function VersionNumber(
const FileName:
String): TVersionNo;
var
VerInfo: Pointer;
Len, BufSize:
{$ifdef DelphiLessThan4}Integer
{$else}Cardinal
{$endif};
Dest: PVSFixedFileInfo;
begin
FillChar(Result, SizeOf(Result), 0);
//How big is version info?
BufSize := GetFileVersionInfoSize(PChar(FileName), Len);
if BufSize > 0
then
begin
//Reserve sufficient memory
GetMem(VerInfo, BufSize);
try
//Get version information
if GetFileVersionInfo(PChar(FileName), 0, BufSize, VerInfo)
then
//Get translation table
if VerQueryValue(VerInfo, '
\', Pointer(Dest), Len)
then
with Dest^
do
begin
Result.MS := dwFileVersionMS;
Result.LS := dwFileVersionLS
end
finally
//Free sufficient memory
FreeMem(VerInfo, BufSize)
end
end
end;
procedure CheckRedirector;
procedure CheckFile(
const FileName, Vn:
String; Hi, Lo: Cardinal);
var
Ver: TVersionNo;
const
ErrorA = '
You need a newer system file. %s is version %d.%d.%d.';
ErrorB = '
It should be version %s.'#13#13'
Get an update to this file from ' +
'
http://support.microsoft.com/download/support/mslfiles/vrdrupd.exe';
Error1 = ErrorA + ErrorB;
Error2 = ErrorA + '
%d.' + ErrorB;
begin
Ver := VersionNumber(FileName);
if (Ver.MS < Hi)
or ((Ver.MS = Hi)
and (Ver.LS < Lo))
then
//If the high word of the low DWord of the version info is 0,
//the 0 is never written in MS version info strings
if HiWord(Ver.LS) = 0
then
ShowMessage(Format(Error1, [FileName, HiWord(Ver.MS),
LoWord(Ver.MS), LoWord(Ver.LS), Vn]))
else
ShowMessage(Format(Error2, [FileName, HiWord(Ver.MS),
LoWord(Ver.MS), HiWord(Ver.LS), LoWord(Ver.LS), Vn]))
end;
var
Dir:
array[0..255]
of Char;
begin
GetSystemDirectory(Dir, SizeOf(Dir));
CheckFile(
String(Dir) + '
\VREDIR.VXD', '
4.0.1116', $40000, 1116);
CheckFile(
String(Dir) + '
\VNETSUP.VXD', '
4.0.1112', $40000, 1112);
end;
procedure CheckRegistryEntry(Reg: TRegistry;
const Path, Value:
String;
const Default, Desired: Variant; Size: Byte);
var
TmpInt: Cardinal;
begin
with Reg
do
if OpenKey(Path, True)
then
try
case VarType(Desired)
of
varInteger:
{ Some numbers need to be stored as DWORD values, }
{ while some need to be stored as binary values }
if Size = 0
then
begin
if not ValueExists(Value)
or
(ReadInteger(Value) =
Default)
then
begin
WriteInteger(Value, Desired);
RebootRequired := True
end
end
else
begin
TmpInt :=
Default;
if ValueExists(Value)
then
ReadBinaryData(Value, TmpInt, Size);
if TmpInt =
Default then
begin
TmpInt := Desired;
WriteBinaryData(Value, TmpInt, Size);
RebootRequired := True
end
end;
varString:
begin
if not ValueExists(Value)
or
(ReadString(Value) =
Default)
then
begin
WriteString(Value, Desired);
RebootRequired := True
end
end
end
finally
CloseKey
end
end;
const
Control = '
System\CurrentControlSet\Control\';
Services = '
System\CurrentControlSet\Services\';
procedure CheckWin95Registry;
var
Reg: TRegistry;
const
DOSRequester = '
Network\Novell\System Config\Netware Dos Requester';
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKey_Local_Machine;
//Fix VREDIR.VxD settings
CheckRegistryEntry(Reg, Services + '
VxD\VREDIR', '
DiscardCacheOnOpen', 0, 1, SizeOf(Byte));
//Fix NWREDIR.VxD settings
CheckRegistryEntry(Reg, Services + '
VxD\NWREDIR', '
ReadCaching', 1, 0, SizeOf(Byte));
//Fix Novell settings
CheckRegistryEntry(Reg, DOSRequester, '
Cache Writes', '
Yes', '
No', 0);
CheckRegistryEntry(Reg, DOSRequester, '
Opportunistic Locking', '
Yes', '
No', 0);
//Fix FileSystem troubleshooting settings
CheckRegistryEntry(Reg, Control + '
FileSystem', '
DriveWriteBehind', $FFFFFFFF, 0, SizeOf(Longint));
{$define AllOptionsThatPeopleSuggest}
{$ifdef AllOptionsThatPeopleSuggest}
CheckRegistryEntry(Reg, Control + '
FileSystem', '
SoftCompatMode', 1, 0, SizeOf(Longint));
CheckRegistryEntry(Reg, Control + '
FileSystem', '
AsyncFileCommit', 0, 1, SizeOf(Byte));
{$endif}
finally
Reg.Free
end
end;
procedure CheckWinNTRegistry;
var
Reg: TRegistry;
begin
Reg := TRegistry.Create;
try
Reg.RootKey := HKey_Local_Machine;
//Disable opportunistic locking & caching
CheckRegistryEntry(Reg, Services + '
LanmanServer\Parameters', '
EnableOpLocks', 1, 0, 0);
CheckRegistryEntry(Reg, Services + '
LanmanServer\Parameters', '
CachedOpenLimit', 1, 0, 0);
CheckRegistryEntry(Reg, Services + '
LanmanWorkStation\Parameters', '
UseOpportunisticLocking', 1, 0, 0);
CheckRegistryEntry(Reg, Services + '
LanmanWorkStation\Parameters', '
UtilizeNtCaching', 1, 0, 0);
//Make sure NetWare popups are enabled to avoid a documented issue
CheckRegistryEntry(Reg, Services + '
NWCWorkstation\Parameters', '
DisablePopup', 1, 0, 0);
finally
Reg.Free
end
end;
{$else}
procedure CheckWin31Registry;
begin
with TIniFile.Create('
System.Ini')
do
try
if ReadString('
386Enh', '
ForceLazyOff', '
') = '
'
then
begin
{ You need to put appropriate value for data drive letters!!! }
WriteString('
386Enh', '
ForceLazyOff', '
CDE');
RebootRequired := True
end
finally
Free
end
end;
{$endif}
function CheckRegistryIsAcceptable:boolean;
begin
CheckRegistryIsAcceptable:=true;
{$ifdef Win32}
case Win32Platform
of
VER_PLATFORM_WIN32_WINDOWS: CheckWin95Registry;
VER_PLATFORM_WIN32_NT: CheckWinNTRegistry;
end;
if RebootRequired
then
//Use standard Win32 reboot dialog
begin
CheckRegistryIsAcceptable:=false;
RestartDialog(0,
nil, ew_RestartWindows)
end;
{$else}
CheckWin31Registry;
if RebootRequired
then
begin
ShowMessage('
Es wurden Änderungen an der Registry drchgeführt. Bitte starten Sie Windows neu.');
CheckRegistryIsAcceptable:=false;
ExitWindows(ew_RestartWindows, 0)
end
{$endif}
end;
function CheckOKForParadoxAppToRun:boolean;
begin
{$ifdef Win32}
//Only Win95 redirector files need checking
if Win32Platform = VER_PLATFORM_WIN32_WINDOWS
then
CheckRedirector;
{$endif}
CheckOKForParadoxAppToRun:=CheckRegistryIsAcceptable;
{ CheckLocalShare;}
end;
end.