madExcept config Load/saving bug

contains all delphi packages mentioned below
Post Reply
katar1024
Posts: 7
Joined: Tue Aug 14, 2018 2:41 pm

madExcept config Load/saving bug

Post by katar1024 »

First of all, there is an character conflict problem, I have that you using a character of #$b4 that point out of no value while using GetPrivateProfileStringA, but in Asia Character it was recognized as a Chinese Character with the bytes follow, so IDE displayed as an unterminated statement and don’t let compiling.
The solution is using #$b4 instead of using quoted characters, and It will be fine
傲游截图20180821151340.png
傲游截图20180821151340.png (249.05 KiB) Viewed 12357 times
here is my changes:
if (GetPrivateProfileStringA(PAnsiChar(section), PAnsiChar(key), #$b4, arrCh, MAX_PATH, PAnsiChar(fileName)) <> 1) or
(arrCh[0] <> #$b4) then begin
if (GetPrivateProfileStringA(PAnsiChar(section), PAnsiChar(key), #$b4, arrCh, MAX_PATH, PAnsiChar(fileName)) <> 1) or
(arrCh[0] <> #$b4) then begin
if (GetPrivateProfileStringA(PAnsiChar(section), PAnsiChar(key), #$b4, pc, 32 * 1024, PAnsiChar(fileName)) <> 1) or
(pc[0] <> #$b4) then begin
if (GetPrivateProfileStringA('AppendMapFile', 'Enabled', #$b4, pointer(@arrCh), MAX_PATH, PAnsiChar(fn)) <> 1) or
(PAnsiChar(@arrCh)^ <>#$b4) then begin
if (GetPrivateProfileStringA(PAnsiChar(section), PAnsiChar(key), #$b4, pc, 32 * 1024, PAnsiChar(fileName)) <> 1) or
(pc[0] <> #$b4) then
madshi
Site Admin
Posts: 10749
Joined: Sun Mar 21, 2004 5:25 pm

Re: madExcept config Load/saving bug

Post by madshi »

Thank you, I've applied your changes to my source code.
katar1024
Posts: 7
Joined: Tue Aug 14, 2018 2:41 pm

Re: madExcept config Load/saving bug

Post by katar1024 »

And then I have found a mes config file saving and loading bug from a network sharing, and this also causes a slow speed,
In my situation, I have set up a sharing machine in my LAN and stored my project coding by using windows share, so all laptop and virtual machine can developing and debugging with shared files.
And I found that .mes file will be locked when a same project opened twice or more in multiple IDE while invoking API call of GetPrivateProfileStringA. This causes madExceptWizard invoking GetPrivateProfileStringA and WritePrivateProfileStringA failure and nothing can be read or write to .mes file, so madExceptWizard seems to treat it as there was no .mes file were stored then gives a blank config.

In other way, the system api of GetPrivateProfileString and WritePrivateProfileString will take operation with the whole file content, in hard drive or removable drive the IO Speed is always faster so read or write amount of config will not take too much time. But in a network environment, especially a bad traffic situation like only haves the 10Mb link speed, the more unnecessary file data transacted, the much more speed will bring down the operation, such like loading, saving and compinlig(using the madExceptPatcher) the project. For example I have a project group that have more than 15 sub projects and I had deployed madExcept in each of them, it will takes about 30s to open and load the whole project group, and it also takes much more time to saving or compiling of them.

Here is my solution. The best way to solve this is self -implements a config read/write class that loads or flushes a config file data only once time. In a test case, I don’t have the codes of madExceptPatcher, so I had to write a dll and hooked all PrivateProfile API and handling the load and saving only when config file path changed. The purpose is pulling down the IO times and avoid config file locking by system, and it’s had an amazing effect almost likes the speed of working on hard drive(about 10 times more faster).
The all of the works is how to setting up a self-implemented Config read/write class in unit madExceptPatcher, and by the way there is no need to write an empty config file, to make less junk files.

and i have strongly recommend that using self-implemented Config class and it will be also fix up the character problem above
Good Luck to next version!
katar1024
Posts: 7
Joined: Tue Aug 14, 2018 2:41 pm

Re: madExcept config Load/saving bug

Post by katar1024 »

and here is my code of solution, you can uses it as a reference:

Code: Select all

unit U_Profile;

interface

uses
  Windows,
  U_xhUtils, U_xhHash;

type
  IProfileSection = interface
    //function _GetList(): TSA;
    function _GetLines(): TSA;
    function _GetSectionName(): String;
    function _GetBooleanValue(const key_name: String): Boolean;
    function _GetIntegerValue(const key_name: String): Integer;
    function _GetStringValue(const key_name: String): String;
    procedure _SetStringValue(const key_name: String; const value: String);
    function GetValue(const key_name: String; out Value: String): Boolean;
    function _Equal(const h_sect: Cardinal): Boolean;
    procedure AppendLine(const s_line: String);
    //property List: TSA read _GetList;
    property Lines: TSA read _GetLines;
    property SectionName: String read _GetSectionName;
    property BV[const key_name: String]: Boolean read _GetBooleanValue;
    property IV[const key_name: String]: Integer read _GetIntegerValue;
    property SV[const key_name: String]: String read _GetStringValue write _SetStringValue; default;
  end;

  TProfile = class;

  TProfileSection = class(TInterfacedObject, IProfileSection)
  private
    FSectionName: String;
    FSectionHash: Cardinal;
    FLines: TSA;
    FProfile: TProfile;
    //function _GetList(): TSA;
    function _GetLines(): TSA;
    function _GetSectionName(): String;
    function _GetBooleanValue(const key_name: String): Boolean;
    function _GetIntegerValue(const key_name: String): Integer;
    function _GetStringValue(const key_name: String): String;
    procedure _SetStringValue(const key_name, Value: String);
    //procedure _SetStringValue(const key_name: String; const value: String);
    function _Equal(const h_sect: Cardinal): Boolean;
    procedure AppendLine(const s_line: String);
    function GetValue(const key_name: String; out Value: String): Boolean;
  end;

  TProfile = class
  private
    procedure AsyncSave();
  protected
    FSections: array of IProfileSection;
    FModified: Boolean;
    function GetSection(const sect_name: String): IProfileSection;
  public
    procedure LoadFile(const s_file: String);
    procedure LoadStr(const str: String);
    procedure SaveFile(const s_file: String);
    function AppendSection(const s_sect: String): IProfileSection;
    property Sections[const sect_name: String]: IProfileSection read GetSection; default;
  end;

  procedure ChangeProfile(const s_file: String);

var
  Profile: TProfile;

implementation

var
  s_profile: String;

procedure ChangeProfile(const s_file: String);
begin
  if not Assigned(Profile) then
    Profile := TProfile.Create();
  if s_profile = s_file then
    exit;
  with Profile do begin
    if s_profile <> '' then
      SaveFile(s_profile);
    LoadFile(s_file);
    s_profile := s_file;
  end;
end;

function GetHash(const s: String): Cardinal;
begin
  Result := HashOf(Trim(s), True);
end;

function SplitList(const s_list: String{; const exc_list: TSA}): TSA;
var
  i, j{, k}, l: Integer;
  a: TSA;
  s: String;
begin
  a := Split(s_list, ',');
  l := LengthOf(a);
  SetLength(Result, l);
  j := 0;
  for i := 0 to High(a) do begin
    s := Trim(a[i]);
    if s = '' then
      continue;
    {for k := 0 to j do
      if EqualText(s, Result[j]) then begin
        s := '';
        break;
      end;
    for k := 0 to High(exc_list) do
      if EqualText(s, exc_list[j]) then begin
        s := '';
        break;
      end;
    if s = '' then
      continue;}
    Result[j] := s;
    Inc(j);
  end;
  SetLength(Result, j);
end;

{ TProfileSection }

procedure TProfileSection.AppendLine(const s_line: String);
begin
  Append(FLines, s_line);
end;

function TProfileSection.GetValue(const key_name: String;
  out Value: String): Boolean;
var
  i: Integer;
  k, v: String;
begin
  for I := 0 to High(FLines) do begin
    v := SplitProp(FLines[i], k);
    if EqualText(Trim(k), key_name) then begin
      Value := Trim(v);
      Exit(True);
    end;
  end;
  Result := False;
end;

procedure TProfileSection._SetStringValue(const key_name, Value: String);
var
  i, j: Integer;
  k: String;
begin
  j := -1;
  for I := 0 to High(FLines) do begin
    SplitProp(FLines[i], k);
    if EqualText(Trim(k), key_name) then begin
      j := i;
      break;
    end;
  end;
  if j < 0 then begin
    j := LengthOf(FLines);
    SetLength(FLines, j + 1);
  end;
  FLines[j] := key_name + '=' + Value;
  with FProfile do begin
    FModified := True;
    AsyncInvoke(AsyncSave);
  end;
end;

function TProfileSection._Equal(const h_sect: Cardinal): Boolean;
begin
  Result := (h_sect = FSectionHash);
end;

function TProfileSection._GetBooleanValue(const key_name: String): Boolean;
var
  s: String;
begin
  Result := GetValue(key_name, s);
  if Result then begin
    s := LowerCase(s);
    if (s = '') or (s = '0') or (s[1] = 'f') then
      Result := False;
  end;
end;

function TProfileSection._GetIntegerValue(const key_name: String): Integer;
begin
  Result := StrToIntDef(_GetStringValue(key_name), 0);
end;

function TProfileSection._GetLines: TSA;
begin
  Result := FLines;
end;

{function TProfileSection._GetList: TSA;
var
  a: TSA;
  g: TIA;
  h, i, j, k, l: Integer;
  s: String;
begin
  l := 0;
  for I := 0 to High(FLines) do begin
    a := SplitList(LowerCase(FLines[i]));
    j := l + LengthOf(a);
    SetLength(Result, j);
    SetLength(g, j);
    for j := 0 to High(a) do begin
      s := a[j];
      h := HashOf(s);
      for k := 0 to l do
        if g[i] = h then begin
          s := '';
          break;
        end;
      if s <> '' then begin
        Result[l] := s;
        g[l] := h;
        Inc(l);
      end;
    end;
  end;
  SetLength(Result, l);
end;       }

function TProfileSection._GetSectionName: String;
begin
  Result := FSectionName;
end;

function TProfileSection._GetStringValue(const key_name: String): String;
var
  s: String;
begin
  if GetValue(key_name, s) then begin
    Result := s;
  end
  else
    Result := '';
end;

{procedure TProfileSection._SetStringValue(const key_name, value: String);
begin
  SetValue(key_name, value);
end; }

{ TProfile }

function TProfile.AppendSection(const s_sect: String): IProfileSection;
var
  sect: TProfileSection;
  i: Integer;
begin
  if s_sect = '' then
    exit;
  sect := TProfileSection.Create();
  Result := sect;
  with sect do begin
    FSectionName := s_sect;
    FSectionHash := GetHash(s_sect);
    FProfile := Self;
  end;
  i := LengthOf(FSections);
  SetLength(FSections, i + 1);
  FSections[i] := Result;
  FModified := True;
end;

procedure TProfile.AsyncSave;
begin
  SaveFile(s_profile);
end;

function TProfile.GetSection(const sect_name: String): IProfileSection;
var
  h_sec: Cardinal;
  i: Integer;
begin
  h_sec := GetHash(sect_name);
  for I := 0 to High(FSections) do begin
    Result := FSections[i];
    with Result do
      if _Equal(h_sec) then
        exit;
  end;
  Result := AppendSection(sect_name);
end;

procedure TProfile.LoadFile(const s_file: String);
var
  s: String;
begin
  if not FLT(s, s_file) then
    s := '';
  LoadStr(s);
end;

procedure TProfile.LoadStr(const str: String);
var
  a: TSA;
  s: String;
  i, j: Integer;
  c: Char;
  sect: IProfileSection;

  function IsRem(): Boolean;
  const
    REM_CHARS: array[0..3] of Char = ('#', '<', '{', ';');
  var
    d: Char;
  begin
    for d in REM_CHARS do
      if d = c then
        Exit(True);
    Result := False;
  end;

begin
  sect := nil;
  SetLength(FSections, 0);
  if str = '' then
    exit;
  a := Split(str, vbCrLf);
  for I := 0 to High(a) do begin
    s := a[i];
    //if Len(s) > 8192 then
    //  s := Left(s, 8192);
    s := Trim(s);
    if s = '' then
      continue;
    c := s[1];
    if IsRem() then
      continue
    else if (c = '[') then begin
      j := Instr(s, ']');
      if j < 1 then
        continue;
      s := MidStr(s, 2, j - 2);
      if s = '' then
        continue;
      s := Trim(s);
      sect := AppendSection(s);
    end
    else if Assigned(sect) then
      sect.AppendLine(s);
  end;
  FModified := False;
end;

procedure TProfile.SaveFile(const s_file: String);
var
  a, b: TSA;
  I: Integer;
begin
  if not FModified then
    exit;
  for I := 0 to High(FSections) do
    with FSections[i] do begin
      AddStr(a, '[%s]', [SectionName]);
      b := Lines;
      if Length(b) > 0 then begin
        Append(a, b);
        Append(a, '');
      end;
    end;
  if Len(a) > 1 then
    FSA(a, s_file);
  FModified := False;
end;

initialization

finalization
  FreeAndNil(Profile);

end.

Code: Select all

unit U_ApiHook;

interface

uses
  Windows,
  U_xhUtils, U_xhPeUtils,
  U_Profile;

  procedure Init();

implementation

procedure CvtUnicodeParam(var s_app, s_key, s_file: UnicodeString; const lpAppName, lpKeyName, lpFileName: PAnsiChar);
begin
  s_app :=  UnicodeString(lpAppName);
  s_key :=  UnicodeString(lpKeyName);
  s_file := UnicodeString(lpFileName);
end;

function Thunk_GetPrivateProfileStringW(lpAppName, lpKeyName, lpDefault: PWideChar; lpReturnedString: PWideChar; nSize: DWORD; lpFileName: PWideChar): DWORD; stdcall;
var
  v: String;
begin
  ChangeProfile(lpFileName);
  if Profile[lpAppName].GetValue(lpKeyName, v) then
    v := lpDefault;
  if Len(v) > 0 then begin
    lstrcpynW(lpReturnedString, Pointer(v), nSize);
    Result := lstrlenW(lpReturnedString);
  end
  else begin
    lpReturnedString[0] := #0;    
    Result := 0;
  end;
end;

function Thunk_GetPrivateProfileStringA(lpAppName, lpKeyName, lpDefault: PAnsiChar; lpReturnedString: PAnsiChar; nSize: DWORD; lpFileName: PAnsiChar): DWORD; stdcall;
var
  s_app:  UnicodeString;
  s_key:  UnicodeString;
  s_file: UnicodeString;
  s_def:  UnicodeString;
  s_buf:  UnicodeString;
  a_buf:  AnsiString;
begin
  CvtUnicodeParam(s_app, s_key, s_file, lpAppName, lpKeyName, lpFileName);
  s_def := UnicodeString(lpDefault);
  SetLength(s_buf, nSize);
  ChangeProfile(s_file);
  if Profile[s_app].GetValue(s_key, s_buf) and (Len(s_buf) > 0) then begin
    a_buf := AnsiString(s_buf);
    lstrcpynA(lpReturnedString, Pointer(a_buf), nSize);
  end
  else
    lstrcpynA(lpReturnedString, lpDefault, nSize);
  Result := lstrlenA(lpReturnedString);
end;

function Thunk_WritePrivateProfileStringW(lpAppName, lpKeyName, lpString, lpFileName: PWideChar): BOOL; stdcall;
begin
  ChangeProfile(lpFileName);
  Profile[lpAppName][lpKeyName] := lpString;
  Result := True;
end;

function Thunk_WritePrivateProfileStringA(lpAppName, lpKeyName, lpString, lpFileName: PAnsiChar): BOOL; stdcall;
var
  s_app:  UnicodeString;
  s_key:  UnicodeString;
  s_str:  UnicodeString;
  s_file: UnicodeString;
begin
  CvtUnicodeParam(s_app, s_key, s_file, lpAppName, lpKeyName, lpFileName);
  s_str := UnicodeString(lpString);
  Result := Thunk_WritePrivateProfileStringW(Pointer(s_app), Pointer(s_key), Pointer(s_str), Pointer(s_file));
end;

procedure Init();

  procedure Patch_Module(const s_module: PChar);
  var
    hMod: Cardinal;
  begin
    hMod := GetModuleHandle(s_module);
    if hMod = 0 then
      exit;
    Patch_IAT(hMod, 'kernel32', 'GetPrivateProfileStringW', @Thunk_GetPrivateProfileStringW);
    Patch_IAT(hMod, 'kernel32', 'GetPrivateProfileStringA', @Thunk_GetPrivateProfileStringA);
    Patch_IAT(hMod, 'kernel32', 'WritePrivateProfileStringW', @Thunk_WritePrivateProfileStringW);
    Patch_IAT(hMod, 'kernel32', 'WritePrivateProfileStringA', @Thunk_WritePrivateProfileStringA);
  end;

begin
  Patch_Module('madExceptWizard_.bpl');
  Patch_Module('madExceptPatch.exe');
  //Patch_Module('UEdit32.exe'); //*
end;

end.
madshi
Site Admin
Posts: 10749
Joined: Sun Mar 21, 2004 5:25 pm

Re: madExcept config Load/saving bug

Post by madshi »

Thanks for sharing your code. Hmmmm... But isn't the network cache supposed to take care of problems like this? Is it possible maybe that the network cache doesn't work properly on your PC? In all the years of madExcept nobody else has complained about a similar problem yet.
katar1024
Posts: 7
Joined: Tue Aug 14, 2018 2:41 pm

Re: madExcept config Load/saving bug

Post by katar1024 »

and i don't know why, because i nowly using giga network, all of the nic and switches are giga speed and all of the UPT are class 6
i don't know how to enable or disable the network caching

i think the database of sqlite almost forced requires operation in transact mode, and the puropse is also decrease the disk writing operation

I don't know if the customers is realized the perfomance speed like this

i have counting with the sum of mes file operating by using procmon
and the orginal way tooks more than 20k operations, and my dll fix only tooks less than 400

you can set up a bad network environment for testing by changing the speed of NIC to 10Mb, and
this is a big change and will takes a mount of time, and I can use my fix with short time, then it will be worty to wait for your improvement.
Attachments
傲游截图20180821155809.png
傲游截图20180821155809.png (230.37 KiB) Viewed 12356 times
傲游截图20180821160022.png
傲游截图20180821160022.png (208.11 KiB) Viewed 12356 times
katar1024
Posts: 7
Joined: Tue Aug 14, 2018 2:41 pm

Re: madExcept config Load/saving bug

Post by katar1024 »

to test this case, you can create a projectgroup with at least 20 sub projects then assign all of them with madexcept, then put the whole projectgroup folder into a network sharing for remotly opening, saving or compiling :wink:
Post Reply