Schreib-Cache für Dateisystem ausschalten

[bernau]

Folgende Unit habe ich vor Jahren mal aus torry.net heruntergeladen. Damit habe ich das Paradox-Netzwerk-Problem meist hinbekommen. auch unter WinNT / XP / 2000. Ich hatte allerdings das Problem mit der 16Bit-Version der BDE. Die 32-Bit-Version der BDE habe ich dann erst gar nicht mehr verwendet.


Gerd

Delphi-Quellcode:

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.