Delphi 11.2 and NetAPIBufferFree

david.obrien · 17 January 2023 03:13

I have a project ported to Delphi 11.2 from 10.2 which appears to be going very well. So far.
I now have an issue with a tried and tested function that checks to see if a file share exists. I have put this into its own test form to make it stand-alone.

The issue with this is the NetApiBufferFree(retBuf). This causes a 0x0000374 (Heap corruption) and the program bombs (no error), sometimes. The pattern of failures is very frustrating.

The same files with Delphi 10.2 work fine, so I’m not sure if it is the code or the 11.2 compiler, or maybe a definition somewhere outside the unit.

Here is the test form used:

unit Unit47;
interface
uses
  Vcl.Forms, WinAPI.Windows;
type
  TForm47 = class(TForm)
    procedure FormShow(Sender: TObject);
  end;
  TNetShareGetInfo  = Function(servername : LPWSTR; netname : LPWSTR;
     level : DWORD; var bufptr : LPBYTE) : DWORD stdcall;
  TNetApiBufferFree = function(var bufptr: LPBYTE): DWORD stdcall;
var
  Form47: TForm47;
implementation
{$R *.dfm}
uses System.SysUtils;

function GetPCName: string;
var
   u: array [0 .. 255] of Char;
   sz: DWord;
begin
   sz := 256 + 1;
   GetComputerName(u, sz);
   Result := u;
end;

procedure shareExists(srvName, shareName: String; var shrExists, err: boolean);
var
   reqdSrv, reqdShare: array[0..255] of WideChar;
   retBuf: LPBYTE;
   retVal: Integer;
   NetShareGetInfo: TNetShareGetInfo;
   NetApiBufferFree: TNetApiBufferFree;
   Handle: THandle;
   lastErrVal: LongInt;
   lastError: String;
begin
   Handle := LoadLibrary('netapi32.dll');
   if Handle <> 0 then
   begin
      try
         shrExists := false;
         err := False;
         StringToWideChar(srvName, reqdSrv, Length(srvName) + 1);
         StringToWideChar(shareName, reqdShare, Length(shareName) + 1);
         @NetShareGetInfo := GetProcAddress(Handle, 'NetShareGetInfo');
         if @NetShareGetInfo <> nil then
         begin
            retVal := NetShareGetInfo(reqdSrv, reqdShare, 2, retBuf);
            if (retVal = 0) then
            begin
               @NetApiBufferFree := GetProcAddress(Handle, 'NetApiBufferFree');
               NetApiBufferFree(retBuf);
               shrExists := true
            end;
         end;
      finally
         FreeLibrary(Handle);
      end;
   end;
end;

procedure TForm47.FormShow(Sender: TObject);
var
   ShareExist: Boolean;
   Err: Boolean;
begin
   shareExists('\\' + GetPCName, 'LGCLIENT$', ShareExist, Err);
end;

end.

The program bombs when the share already exists. Only in D11, and inconsistently, I can run it multiple times without a problem, then suddenly it starts crashing.

Any ideas, or any other known way to do this that doesn’t involve a third party?

vincent · 17 January 2023 03:48

Not familiar with the api, but why are you calling StringToWideChar - Delphi 11.x strings are already wide strings (since Delphi 2009).

AaronDC · 17 January 2023 04:23

You are passing in a size (257) that is greater than the array size (256) to the GetComputerName function.

Seems unlikely to be the error as computer names do not typically get set that large.

Roger_Plant · 17 January 2023 04:35

Hi,
I removed the var from TNetApiBufferFree = function(bufptr: LPBYTE): DWORD stdcall;
that seems to help.

I also didn’t get far with 2 in NetshareGetInfo all results came back false, (though doc indicates some requirements needed) So I used 1, which seemed to work in my test case.

retVal := NetShareGetInfo(reqdSrv, reqdShare, 1, retBuf);

vincent · 17 January 2023 04:41

This works for me

program Project1;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils,
   WinAPI.Windows;

type
TNetShareGetInfo  = Function(servername : LPWSTR; netname : LPWSTR;
     level : DWORD; out bufptr : LPBYTE) : DWORD stdcall;
  TNetApiBufferFree = function(bufptr: LPBYTE): DWORD stdcall;


function GetPCName: string;
var
   u: array [0 .. 255] of Char;
   sz: DWord;
begin
   sz := 256 + 1;
   GetComputerName(u, sz);
   Result := u;
end;

procedure shareExists(srvName, shareName: String; var shrExists, err: boolean);
var
   retBuf: LPBYTE;
   retVal: Integer;
   NetShareGetInfo: TNetShareGetInfo;
   NetApiBufferFree: TNetApiBufferFree;
   Handle: THandle;
   lastErrVal: LongInt;
   lastError: String;
begin
   Handle := LoadLibrary('netapi32.dll');
   if Handle <> 0 then
   begin
      try
         shrExists := false;
         err := False;
         @NetShareGetInfo := GetProcAddress(Handle, 'NetShareGetInfo');
         if @NetShareGetInfo <> nil then
         begin
            retVal := NetShareGetInfo(PWideChar(srvName),PWideChar(shareName), 2, retBuf);
            if (retVal = 0) then
            begin
               @NetApiBufferFree := GetProcAddress(Handle, 'NetApiBufferFree');
               if NetApiBufferFree(retBuf) <> 0 then
                RaiseLastOSError;
               shrExists := true
            end;
         end;
      finally
         FreeLibrary(Handle);
      end;
   end;
end;

var
   ShareExist: Boolean;
   Err: Boolean;
begin
  try
    shareExists('\\' + GetPCName, 'CIShare', ShareExist, Err);
  except
    on E: Exception do
      Writeln(E.ClassName, ': ', E.Message);
  end;
end.

david.obrien · 17 January 2023 19:52

Just very old code. I haven’t analyzed all of it yet, but the fault occurs on the NetApiBufferFree line.

david.obrien · 17 January 2023 19:54

Just me when bringing everything into the test unit, replaced a constant with a number. Mistyped…

david.obrien · 17 January 2023 19:59

Thanks for all the replies.
Thinking about it last night, and thinking about what has changed in D11, I thought of ASLR. Turning this off sorts the problem out. Very odd. With ASLR off I have run the program many times without an issue. As soon as I turn it back on, it fails repeatedly.
Perhaps D11’s implementation of ASLR isn’t so good…

david.obrien · 17 January 2023 20:00

I had already tried and dismissed checking the result of NetApiBufferFree. The cause of the issue appears to be ASLR.

vincent · 17 January 2023 21:01

I suspect turning it off may be masking the issue. My version is working fine without turning it off. I made 2 changes

got rid of the StringToWideChar calls
removed var from NetApiBufferFree

david.obrien · 18 January 2023 01:03

I’m guessing you’re right.
Got rid of the StringToWideChar, changed retVar to a pointer, changed reqdSrv, reqdShare to PWideChars.
The test program still randomly fails. Until… I removed the var from NetApiBufferFree. Now it appears to be stable. I would never have thought to look there. Thank you, you’ve saved me many more hours of frustration.

vincent · 18 January 2023 01:35

FWIW, @Roger_Plant also suggested removing the var (we posted within a few minutes of each other).

Translating windows api parameter types is a bit of a black art, easy to get it wrong.

david.obrien · 18 January 2023 01:57

Sure is. I believe this code was written in the days of Windows 98. Been working fine until Delphi 11.
Thanks to everyone for helping out.