Delphi code to get Owner of a Netware file not working - delphi

I'm a Delphi developer and have never programmed for netware. But I need to find the owner of a file on a netware share. After some research, I got this code snippet from a newsgroup (original author: Chris Morgan). It's basically a way to dynamically load netware dll and get the "owner" information of a file. Please look at the function GetNetwareFileOwner.
The problem is, I don't have direct access to a netware share for testing. I'm sending a small test program every time to a user who tests it by selecting a file on the netware share and then reports the results. I'm getting the error code by a small code insert after the call NWIntScanExtenedInfo where it fails with the error codes given below. Any ideas what can be wrong?
Error codes:
1) At first, the following code gave error 899E (INVALID_FILENAME) on the above call. The file name was in English--no special characters there. And the file was selected on the share with a regular File Open dialog.
2) After that, suspecting a case problem, I commented the two AnsiUpperCase lines to keep the name in original case exactly as the File Open Dialog received it. This gives the error 89FF now (NO_FILES_FOUND_ERROR).
P.S. I compiled the test with Delphi 2007. May be there is a structure problem of the top structure. I haven't checked the byte length and alignment. Will do so.
// netware records and function definitions
type
// sizeof(NW_EXT_FILE_INFO) should be 140 bytes - check byte alignment
NW_EXT_FILE_INFO = record
sequence: integer;
parent: integer;
attributes: integer;
uniqueID: shortint;
flags: shortint;
nameSpace: shortint;
nameLength: shortint;
name: array[0..11] of shortint;
creationDateAndTime: integer;
ownerID: integer;
lastArchiveDateAndTime: integer;
lastArchiverID: integer;
updateDateAndTime: integer;
lastUpdatorID: integer;
dataForkSize: integer;
dataForkFirstFAT: integer;
nextTrusteeEntry: integer;
reserved: array[0..35] of shortint;
inheritedRightsMask: word;
lastAccessDate: word;
deletedFileTime: integer;
deletedDateAndTime: integer;
deletorID: integer;
reserved2: array[0..15] of shortint;
otherForkSize: array[0..1] of integer;
end;
// functions defined in CALWIN32.DLL
TNWCallsInit = function(reserved1: pointer;
reserved2: pointer): integer; stdcall;
TNWCallsTerm = function(reserved: pointer): integer; stdcall;
TNWParseNetWarePath = function(const path: pchar; var conn: cardinal;
var dirhandle: cardinal; newpath: pchar): integer; stdcall;
TNWAllocTemporaryDirectoryHandle = function(conn: cardinal;
dirhandle: cardinal; const path: pchar; var newdirhandle: cardinal;
rightsmask: pshortint): integer; stdcall;
TNWDeallocateDirectoryHandle = function(conn: cardinal;
dirhandle: cardinal): integer; stdcall;
TNWIntScanExtendedInfo = function(conn: cardinal; dirhandle: cardinal;
attrs: shortint; iterhandle: Pinteger; const searchPattern: pchar;
var entryinfo: NW_EXT_FILE_INFO; augmentflag: shortint): integer;
stdcall;
TNWGetObjectName = function(conn: cardinal; objID: integer;
objname: pchar; objtype: pword): integer; stdcall;
const
FA_NORMAL = $00;
FA_HIDDEN = $02;
FA_SYSTEM = $04;
// return codes
SUCCESSFUL = $00;
NOT_MY_RESOURCE = $883C;
// get file owner for Netware server file
function GetNetwareFileOwner(const FilePath: string): string;
var
hcalwin: HINST;
NWCallsInit: TNWCallsInit;
NWParseNetWarePath: TNWParseNetWarePath;
NWAllocTemporaryDirectoryHandle: TNWAllocTemporaryDirectoryHandle;
NWIntScanExtendedInfo: TNWIntScanExtendedInfo;
NWGetObjectName: TNWGetObjectName;
NWDeallocateDirectoryHandle: TNWDeallocateDirectoryHandle;
NWCallsTerm: TNWCallsTerm;
hconn,
hdir,
retcode: cardinal;
filedir: string; { DOS path of parent folder
(upper case) }
nwfilename: string; { DOS filename (upper case) }
nwfiledir: array[0..255] of char; { Netware path of
parent folder }
rights: shortint;
i: integer;
entryinfo: NW_EXT_FILE_INFO;
objtype: word;
begin
Result := '';
// load netware client library and required functions
hcalwin := LoadLibrary('calwin32.dll');
if hcalwin<=0 then exit; // netware client not present on PC
#NWCallsInit := GetProcAddress(hcalwin,'NWCallsInit');
#NWParseNetWarePath := GetProcAddress(hcalwin,'NWParseNetWarePath');
#NWAllocTemporaryDirectoryHandle := GetProcAddress(hcalwin,
'NWAllocTemporaryDirectoryHandle');
#NWIntScanExtendedInfo :=
GetProcAddress(hcalwin,'NWIntScanExtendedInfo');
#NWGetObjectName := GetProcAddress(hcalwin,'NWGetObjectName');
#NWDeallocateDirectoryHandle := GetProcAddress(hcalwin,
'NWDeallocateDirectoryHandle');
#NWCallsTerm := GetProcAddress(hcalwin,'NWCallsTerm');
// initialise netware libs
if NWCallsInit(nil,nil)<>SUCCESSFUL then exit;
try
filedir := AnsiUpperCase(ExtractFileDir(FilePath));
retcode := NWParseNetWarePath(pchar(filedir),hconn,hdir,nwfiledir);
if retcode=NOT_MY_RESOURCE then exit; // local or non-netware disk
// get a dir handle
NWAllocTemporaryDirectoryHandle(hconn,0,nwfiledir,hdir,#rights);
// get the file info
i := -1;
nwfilename := AnsiUpperCase(ExtractFileName(FilePath));
retcode := NWIntScanExtendedInfo(hconn,hdir,
FA_NORMAL+FA_SYSTEM+FA_HIDDEN,
#i,pchar(nwfilename),entryinfo,0);
if retcode=SUCCESSFUL then begin
// get file owner name from ID
SetLength(Result,MAX_PATH);
retcode := NWGetObjectName(hconn,entryinfo.ownerID,
pchar(Result),#objtype);
if retcode=SUCCESSFUL then
SetLength(Result,Length(Result)) // got owner
else SetLength(Result,0); // failed to get owner
end;
// deallocate dir handle
NWDeallocateDirectoryHandle(hconn,hdir);
finally
// clean up
NWCallsTerm(nil);
FreeLibrary(hcalwin);
end;
end;

Are you sure about stdcall? Tru cdecl and so on.
Also, You done give information about delphi's version.
If you use a version BEFORE delphi2009 pchar is a one-byte char.
But if you use delphi2009 or next, pchar is 2 byte char.
So, if you need one byte char you must use PAnsiChar insthead.
I don't know if netware dll parameters are unicode or ansi...
Cher.
A.

Related

NetWkstaGetInfo ACCESS_VIOLATION under WIN64

I'm have code, which works fine during many years under WIN32. But yesterday, after compiling under WIN64 I'm got strange ACCESS_VIOLATION error when trying get wki100_langroup field. Where wrong this code? (Computer not in domain and in Delphi 11 debug window I can see, that this field is empty)
const
NERR_SUCCESS = 0;
type
WKSTA_INFO_100 = record
wki100_platform_id: DWORD;
wki100_computername: LPWSTR;
wki100_langroup: LPWSTR;
wki100_ver_major: DWORD;
wki100_ver_minor: DWORD;
end;
LPWKSTA_INFO_100 = ^WKSTA_INFO_100;
function NetWkstaGetInfo(ServerName: LPWSTR; Level: DWORD; var BufPtr: Pointer): DWORD; stdcall;
external 'netapi32.dll' Name 'NetWkstaGetInfo';
function GetDomain: string;
var
PBuf: Pointer;
Res: Integer;
begin
Result := '';
Res := NetWkstaGetInfo(nil, 100, PBuf);
if (Res = NERR_Success) then begin
Result := LPWKSTA_INFO_100(PBuf)^.wki100_langroup; // ACCESS_VIOLATION here
if Assigned(PBuf) then
NetApiBufferFree(PBuf);
end;
end;
Update:
After changing Pointer to PByte I have the same exception
function NetWkstaGetInfo(ServerName: LPWSTR; Level: DWORD; BufPtr: PByte): DWORD; stdcall;
external 'netapi32.dll' Name 'NetWkstaGetInfo';
function GetDomain: string;
var
PBuf: PByte;
Res: Integer;
begin
Result := '';
Res := NetWkstaGetInfo(nil, 100, #PBuf);
if (Res = NERR_Success) then begin
Result := LPWKSTA_INFO_100(PBuf)^.wki100_langroup; // ACCESS_VIOLATION here
if Assigned(PBuf) then
NetApiBufferFree(PBuf);
end;
end;
Screenshots from Win32:
and Win64 breakpoints:
The symptoms suggest that some other code changed default record alignment for WKSTA_INFO_100 record type.
Under 32-bit compiler that wouldn't have an impact because all values in the record are also 32-bit therefore they will be correctly aligned even if other alignment size is specified.
Under 64-bit compiler DWORD is 32-bit, while LPWSTR is 64-bit. With default 8 byte alignment that means there will be 4 padding bytes inserted after wki100_platform_id. If some other alignment is used following fields will not be at correct positions.
To correct this you need to specify 8 byte alignment {$A8} before type declaration.
type
{$A8}
WKSTA_INFO_100 = record
wki100_platform_id: DWORD;
wki100_computername: LPWSTR;
wki100_langroup: LPWSTR;
wki100_ver_major: DWORD;
wki100_ver_minor: DWORD;
end;

Application crashes - 'Application must have only single FDManager'

With Delphi 10.2, I'm using an application that calls a DLL for sending email. Each Application and DLL use a single FDManager for managing connection and configurations.
At times, the application crashes with the message:
[FireDAC][Comp][Clnt]-500. Application must have only single FDManager
Can anyone please help me to resolve this issue?
Application
procedure TPhoenixWordPrintDialog.StoreEmail;
type
TSendDLL = function(H : Hwnd; Recip :PChar; Subject : PChar; Body : PChar;
Loc : PChar; UserID : PChar; Queid : Integer; AttOrderbyList : array of Integer)
: integer; stdcall;
var
Handle : THandle;
SendMail : TSendDLL;
begin
// FDManager ConnectionDefName is assigned with FDConnectionDefs.ini during form creation.
//Ini file is available in the executable path for managing DB configuration
Handle := LoadLibrary(PChar('D:\Mapi.dll'));
#SendMail := GetProcAddress(Handle, 'ShowDllFormModal');
SendMail(Application.Handle, PChar(RecipText), PChar(SubjectText), PChar(BodyText),
PChar(SentLocation), PChar(SenderName), LQueID, AttachmentOrderByArray);
FreeLibrary(Handle);
end;
DLL
function ShowDllFormModal(H : Hwnd; Recipients : PChar; Subject : PChar;
Body: PChar; Loc : PChar; SenderName : PChar;
Queid : Integer;
AttOrderbyList : array of Integer):integer; stdcall;
begin
Application.handle := H;
// One TFDConnection and TFDQuery using by PhoenixEmailForm
PhoenixEmailForm :=TPhoenixEmailForm.Create(Application);
// FDManager, TFDConnection and TFDQuery using here. On creation of EmailDocumentDM,
// FDManager's ConnectionDefFile is assigned with FDConnectionDefs.ini which is available in
// DLL path
EMailDocumentDM := TEMailDocumentDM.Create(Application);
PhxConnect.ConnectTDatabase(EMailDocumentDM.PhoenixMailDataLink,
PhoenixEmailForm.PhxDatLink,1);
try
//
finally
if Assigned(EMailDocumentDM.PhoenixMailDataLink) then
begin
EMailDocumentDM.PhoenixMailDataLink.Close;
FreeandNil(EMailDocumentDM.PhoenixMailDataLink);
end;
if Assigned(PhoenixEmailForm.PhxDatLink) then
begin
PhoenixEMailForm.PhxDatLink.Close;
FreeAndNil(PhoenixEmailForm.PhxDatLink);
end;
EMailDocumentDM.MailFDManager.Close;
end;
Application.handle := 0;
PhoenixEmailForm.Free;
EMailDocumentDM.Free;
end;

Translate a DLL call from PowerBasic to Delphi

I would like to call SPSS 'backend' from Delphi. There is a DLL that I can use (it seems): SPSSio64.DLL. But I can not find the interface definition.
What I have found is an example in PowerBasic:
Read and write SPSS sav files
DECLARE FUNCTION spssOpenRead LIB "spssio32.dll" ALIAS "spssOpenRead#8" (BYVAL fileName AS STRING, BYREF hHandle AS LONG) AS LONG
DECLARE FUNCTION spssCloseRead LIB "spssio32.dll" ALIAS "spssCloseRead#4" (BYVAL hHandle AS LONG) AS LONG
Since I only need functions to read and write a file (all the processing will be done via a syntax in that file), I thought that this example might be enough to deduce how to call equivalent functions from Delphi.
So the question is: how would these declarations be in Delphi (64-bit)?
Based on the SPSS 14.0 for Windows Developer's Guide, and PowerBasic documentation, try something like this:
32-bit:
// spssio32.dll exports both 'spssOpenRead' and 'spssOpenRead#8', which are the same function...
function spssOpenRead(filename: PAnsiChar; var hHandle: Integer): Integer; stdcall; external 'spssio32.dll' {name 'spssOpenRead#8'};
// spssio32.dll exports both 'spssCloseRead' and 'spssCloseRead#4', which are the same function...
function spssCloseRead(hHandle: Integer): Integer; stdcall; external 'spssio32.dll' {name 'spssCloseRead#4'};
64-bit:
// I can't find a copy of spssio64.dll to download, so I can't verify the exported names. Adjust if needed..
function spssOpenRead(filename: PAnsiChar; var hHandle: Integer): Integer; stdcall; external 'spssio64.dll' {name 'spssOpenRead#16'};
function spssCloseRead(hHandle: Integer): Integer; stdcall; external 'spssio64.dll' {name 'spssCloseRead#8'};
For the record, this works:
function LoadDLL(DLLname : string) : Uint64;
var
em : TArithmeticExceptionMask;
begin
em:=GetExceptionmask;
SetExceptionmask(em+[exInvalidOp,exZeroDivide,exOverflow,exUnderflow]);
result:=LoadLibrary(PwideChar(DLLname));
SetExceptionmask(em);
end;
function RunSPSSio(filename : string; instructions : Tinstructions) : boolean;
// This will only read SAV files, not SPS files !
type
TspssOpenRead = function (filename: PAnsiChar; var hHandle: Uint64): Integer;
TspssCloseRead = function(hHandle: Uint64): Integer;
TspssGetInterfaceEncoding = function(hHandle : Uint64): Integer;
TspssSetInterfaceEncoding = function(encoding : integer; hHandle : Uint64): Integer;
const
SPSS_ENCODING_UTF8 = 1;
var
p : integer;
spssOpenRead : TspssOpenRead;
spssCloseRead : TspssCloseRead;
spssGetIFencoding : TspssGetInterfaceEncoding;
spssSetIFencoding : TspssSetInterfaceEncoding;
DLLhandle : Uint64;
fileref : PANSIchar;
begin
result:=false;
DLLhandle:=LoadDLL('C:\SPSS\spssio64.dll'); // hardcoded
if DLLhandle=0
then begin p:=GetLastError();
report('DLL load error '+IntToStr(p));
exit;
end;
try
#SPSSopenRead:=getProcAddress(DLLhandle,'spssOpenRead');
#SPSScloseRead:=getProcAddress(DLLhandle,'spssCloseRead');
#SPSSsetIFencoding:=getProcAddress(DLLhandle,'spssSetInterfaceEncoding');
SPSSsetIFencoding(SPSS_ENCODING_UTF8,DLLhandle);
fileref:=PANSIchar(ANSIstring(filename));
p:=SPSSopenRead(fileref,DLLhandle);
if p<>0
then report('*** SPSSio error '+IntToStr(p))
else begin // SPSS database interactions here
result:=SPSScloseRead(DLLhandle)=0;
end;
finally
freeLibrary(DLLhandle);
end;
end;

Getting Manufacturer, Serial Number, Model from Drive Letter

I'm trying to have some effective code to get vendor, serial number, and model of a USB drive, using its drive letter. I've searched a lot and found several solutions. But I can not determine which one is the best one.
First one is here. Uses hid.pas from JEDI, but I don't know how to use it with a single drive. Specially, function GetHidDeviceInfo is very interesting but requires symbolic link rather that a drive letter. I tried to invite a symbolic link for the drive letter at no avail.
Second one is here. Uses WMI which doesn't seem very clean. My experience tells me that WMI doesn't work on all PCs. The code doesn't work on my own laptop, saying 'The RPC server is unavailable'.
Please advice me on the best way to achieve my goal. Are other ways around?
Update: I'm posting some sample code, combining the results of comments below.
{$APPTYPE CONSOLE}
uses
Windows, Messages, SysUtils, Variants;
type
PHIDDAttributes = ^THIDDAttributes;
HIDD_ATTRIBUTES = record
Size: ULONG; // size of structure (set before call)
VendorID: Word;
ProductID: Word;
VersionNumber: Word;
//
// Additional fields will be added to the end of this structure.
//
end;
THIDDAttributes = HIDD_ATTRIBUTES;
THIDUSBDeviceInfo = Record { contains interface level information of each device}
SymLink : String;
BufferSize : Word;
Handle : THandle;
VID : DWord;
PID : DWord;
VersionNumber : Word;
ManufacturerString : String;
ProductString : String;
SerialNumberString : String;
end;
function GetVolumeNameForVolumeMountPointW(const lpszVolumeMountPoint: LPCWSTR;
lpszVolumeName: LPWSTR; cchBufferLength: DWORD): BOOL; stdcall;
external kernel32;
function HidD_GetAttributes(HidDeviceObject: THandle;
var HidAttrs: THIDDAttributes): LongBool; stdcall;external 'hid.dll' name 'HidD_GetAttributes';
function HidD_GetManufacturerString(HidDeviceObject: THandle;
Buffer: PWideChar; BufferLength: Integer): LongBool; stdcall;external 'hid.dll' name 'HidD_GetManufacturerString';
function HidD_GetProductString(HidDeviceObject: THandle;
Buffer: PWideChar; BufferLength: Integer): LongBool; stdcall;external 'hid.dll' name 'HidD_GetProductString';
function HidD_GetSerialNumberString(HidDeviceObject: THandle;
Buffer: PWideChar; BufferLength: Integer): LongBool; stdcall;external 'hid.dll' name 'HidD_GetSerialNumberString';
function GetVolumeName(Name: string): string;
var
Volume: array [0..MAX_PATH] of Char;
begin
FillChar(Volume[0], SizeOf(Volume), 0);
GetVolumeNameForVolumeMountPointW(PChar(Name), #Volume[0], SizeOf(Volume));
Result := Volume;
end;
Function GetHidDeviceInfo( Symlink : PChar) : THIDUSBDeviceInfo;
Var
pstr : pWideChar;
DevHandle : THandle;
HidAttrs : THIDDAttributes;
Begin
FillChar(Result, SizeOf( Result), 0);
Result.SymLink := SymLink+ #0;
GetMem( pstr, 512);
DevHandle := CreateFile( Symlink,
GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE,
nil,
OPEN_EXISTING,
0,
0);
If DevHandle <> INVALID_HANDLE_VALUE then
begin
If HidD_GetAttributes( DevHandle,HidAttrs) then
begin
result.VID := HidAttrs.VendorID;
result.PID := HidAttrs.ProductID;
result.VersionNumber := HidAttrs.VersionNumber;
end;
If HidD_GetManufacturerString( DevHandle, pstr, 512) then
Result.ManufacturerString := pStr;
If HidD_GetProductString( DevHandle, pstr, 512) then
Result.ProductString := pStr;
If HidD_GetSerialNumberString( DevHandle, pstr, 512) then
Result.SerialNumberString := pStr;
closeHandle( DevHandle);
end;
FreeMem( pStr);
End;
procedure Main;
var
VolumeName: string;
info: THIDUSBDeviceInfo;
begin
VolumeName:=GetVolumeName('i:\'); //assuming that I: is a USB drive
info:=GetHidDeviceInfo(pchar(VolumeName));
Writeln(info.SerialNumberString);
end;
begin
Main;
Readln;
end.
You can try to obtain SerialNumber of disk (and more information) using WMI.
Usin WMI and the Win32_DiskDrive class, you can get the Serial Number. The documentation say: "Windows Server 2003 and Windows XP: This property is not available."
In Windows Vista,7/8 works fine.
To try if this method is good for you, try this simple demo on clubdelphi ftp(source included and binary included). In Windows 7 you get information like this:
If you can obtain a correct serial, you can use WMI.
Good library for work with WMI is GLibWMI on Sourceforge. Include a specific component (DiskDriveInfo) that you can use with 0 code lines.
See demo.
Regards

openssl error "assertion failed" during EVP_EncryptFinal_ex, delphi

While working with openSSL library, I met a problem with EVP_EncryptFinal_ex.
Concretely, it fails with fatal error ./crypto/evp/evp_enc.c(348) OpenSSL internal error, assertion failed: b <= sizeof ctx -> buf every time, not depending on algorithm (aes or des).
Here is my code. It is simplified as much as possible.
procedure AESTest;
var
key : TBytes;
keyLen : Integer;
dataIn : string;
dataOut : TBytes;
inLen, outLen, resLen : integer;
// Context of an algorithm pointer
e_ctx : Pointer;
begin
// 256 bit key
keyLen := 32;
setlength(key, KeyLen);
RAND_bytes(#(key[0]), KeyLen);
// Input data to encrypt
dataIn := 'Simple data of 29 bits length';
inLen := length(dataIn);
// Init ctx
e_ctx := EVP_CIPHER_CTX_new();
EVP_CIPHER_CTX_init(e_ctx);
EVP_EncryptInit_ex(e_ctx, EVP_aes_256_cbc, nil, #key[0], nil);
// Prepare ouput buf in order to openSSL docs
outLen := inLen + EVP_CIPHER_CTX_block_size(e_ctx) - 1;
setlength(dataOut, outLen);
EVP_EncryptUpdate(e_ctx, #dataOut[0], outLen, #dataIn[1], inLen);
EVP_EncryptFinal_ex(e_ctx, #dataOut[outLen], resLen);
outLen := outLen + resLen;
setlength(dataOut, outLen);
// ... here goes decryption part but it does not matter now
end;
Just to be precise, imports used:
const
LIB_DLL_NAME = 'libeay32.dll';
type
PEVP_CIPHER_CTX : Pointer;
PEVP_CIPHER : Pointer;
function EVP_CIPHER_CTX_new : PEVP_CIPHER_CTX; cdecl; external LIB_DLL_NAME;
procedure EVP_CIPHER_CTX_init(a: PEVP_CIPHER_CTX); cdecl; external LIB_DLL_NAME;
function EVP_aes_256_cbc : PEVP_CIPHER_CTX; cdecl; external LIB_DLL_NAME;
function RAND_bytes(Arr : PByte; ArrLen : integer) : integer; cdecl; external LIB_DLL_NAME;
function EVP_CIPHER_CTX_block_size(ctx: PEVP_CIPHER_CTX): integer; cdecl; external LIB_DLL_NAME;
function EVP_EncryptInit_ex(ctx: PEVP_CIPHER_CTX; cipher_type: PEVP_CIPHER; Engine : Pointer; key: PByte; iv: PByte): integer; cdecl; external LIB_DLL_NAME;
function EVP_EncryptUpdate(ctx: PEVP_CIPHER_CTX; data_out: PByte; var outl: integer; data_in: PByte; inl: integer): integer; cdecl; external LIB_DLL_NAME;
function EVP_EncryptFinal_ex(ctx: PEVP_CIPHER_CTX; data_out: PByte; var outl: integer): integer; external LIB_DLL_NAME;
I actually tried to read source codes (evp_enc.c) and found the assertion:
OPENSSL_assert(b <= sizeof ctx->buf);
Here b is size of a block for current cypher. This assertion makes sense, but still I can't figure out how it could be failed in my code.
I am trying to beat this problem for a couple of days already, and I would be grateful for any advices.
UPDATE: Here are two lines from evp_enc.c:
b=ctx->cipher->block_size;
OPENSSL_assert(b <= sizeof ctx->buf);
according to the code, b is a size of block for current cipher, for aes_256_cbc it is 16 bit long.
The problem is in your declaration of the function EVP_EncryptFinal_ex. You shoud add cdecl directive (like in all other functions).
So, the new declaration will be:
function EVP_EncryptFinal_ex(ctx: PEVP_CIPHER_CTX; data_out: PByte; var outl: integer): integer; cdecl; external LIB_DLL_NAME;

Resources