Delphi-PRAXiS - Schreib-Cache für Dateisystem ausschalten

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.