I'd like to be able to use the UrlCreateFromPathW function from Shlwapi.dll in my installer script, but I haven't been able to get it to work.
HRESULT UrlCreateFromPath(
_In_ PCTSTR pszPath,
_Out_ PTSTR pszUrl,
_Inout_ DWORD *pcchUrl,
DWORD dwFlags
);
I've cobbled together the following from other "Inno Setup" tagged questions here, and from glancing at the JEDI translation for the DLL. TryUrlCreateFromPath always returns false. Any assistance would be much appreciated.
[Code]
const
INTERNET_MAX_URL_LENGTH = 2048 + 32 + 3;
S_OK = $00000000;
function UrlCreateFromPathW(pszPath, pszUrl: string; var pcchUrl: DWORD; dwFlags: DWORD): HResult; external 'UrlCreateFromPathW#Shlwapi.dll stdcall';
function TryUrlCreateFromPath(const path: string; var url: string): Boolean;
var
charcount: dword;
flags: dword;
begin
SetLength(url, INTERNET_MAX_URL_LENGTH);
flags := 0;
Result := UrlCreateFromPathW(path, url, charcount, flags) = S_OK;
if Result then
SetLength(url, charcount);
end;
function InitializeSetup: Boolean;
var
URL: string;
ErrorCode: Integer;
begin
Result := True;
if TryUrlCreateFromPath('c:\temp', URL) then
MsgBox('URL: ' + URL, mbConfirmation, MB_OK)
else
MsgBox('ERROR', mbError, MB_OK);
end;
The pcchUrl is an in/out argument. On input, it must contain a number of characters allocated in the pszUrl.
You do not initialize it. It most likely defaults to 0, hence the UrlCreateFromPath returns E_INVALIDARG.
Initialize it like:
charcount := INTERNET_MAX_URL_LENGTH;
Related
I have some code which uses EnumFontFamiliesEX to determine whether a particular font (using its "facename") is installed. The code was working fine in 32-bit. When I compile and run it as 64-bit, it kept throwing an exception in the callback routine.
I have now gotten it to work under both BUT only if instead of passing the function FindFontbyFaceName's result as the 4th parameter to EnumFontFamiliesEX, I pass a local (or global) variable - MYresult in this case. (And then set result from it). I don't understand what is going on? Can anyone explain or point me to a better way. (I'm not so much interested in the mechanics of the fonts, as the basic callback mechanics).
// single font find callback
function FindFontFace( {$IFDEF CPUX86} lpelf: PLogFont; {$ENDIF}
{$IFDEF CPUX64} lpelf: PEnumLogFontEx; {$ENDIF}
lpntm: PNewTextMetricEx;
AFontType: DWORD; var Aresult: lparam): integer ; stdcall;
begin
result := 0; // 1 shot only please - not interested in any variations in style etc
if (lpelf <> nil) then
Aresult := -1 // TRUE
else
Aresult := 0;
end;
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): boolean;
var
lf: TLogFont;
Myresult: boolean;
begin
MYresult := false;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
// this works in both 32 and 64 bit
EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, lparam(#MYresult), 0);
result := MYresult;
// this works in 32 bit but throws exception in callback in 64 bit
// EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, lparam(#result), 0);
end;
function FindFont(const AFacename: string): boolean;
var
AImage: TImage;
begin
AImage := Timage.Create(nil);
try
result := FindFontbyFaceName(AImage.Canvas, Afacename);
finally
Aimage.Free;
end;
end;
Your callback function is not declared correctly. You are declaring the last parameter as a var LPARAM, which is wrong. The lParam parameter is passed by value, not by reference. When calling EnumFontFamiliesEx() you are passing a pointer to a Boolean as the lParam value.
Your callback is trying to write sizeof(LPARAM) number of bytes to a memory address that only has SizeOf(Boolean) bytes available (and why are you trying to write a -1 to a Boolean?). So you are overwriting memory. When using a pointer to a local variable as the lParam, you are likely just overwriting memory on the calling function's call stack that does not really matter, so you don't see a crash.
You need to either:
remove the var and typecast the lParam parameter to a PBoolean:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: LPARAM): Integer ; stdcall;
begin
PBoolean(lParam)^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
Or:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: PBoolean): Integer ; stdcall;
begin
lParam^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
leave the var but change the parameter type to Boolean instead of LPARAM:
function FindFontFace( var lpelf: TLogFont;
var lpntm: TTextMetric;
FontType: DWORD;
var lParam: Boolean): Integer ; stdcall;
begin
lParam := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
Either approach will allow you to pass #Result as the lParam to EnumFontFamiliesEx() in both 32bit and 64bit:
function FindFontbyFaceName(ACanvas: TCanvas; const AFacename: string): Boolean;
var
lf: TLogFont;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
EnumFontFamiliesEX(ACanvas.Handle, lf, #FindFontFace, LPARAM(#Result), 0);
end;
On a side note, creating a TImage just to have a canvas to enumerate with is wasteful. You don't need it at all:
function FindFontFace( lpelf: PLogFont;
lpntm: PTextMetric;
FontType: DWORD;
lParam: LPARAM): integer ; stdcall;
begin
PBoolean(lParam)^ := True;
Result := 0; // 1 shot only please - not interested in any variations in style etc
end;
function FindFont(const AFacename: string): Boolean;
var
lf: TLogFont;
DC: HDC;
begin
Result := False;
FillChar(lf, SizeOf(lf), 0);
StrLCopy(lf.lfFaceName, PChar(AFacename), 32);
lf.lfCharSet := DEFAULT_CHARSET;
DC := GetDC(0);
EnumFontFamiliesEx(DC, lf, #FindFontFace, LPARAM(#Result), 0);
ReleaseDC(0, DC);
end;
That being said, you can simplify the code if you use the TScreen.Fonts property instead of calling EnumFontFamiliesEx() directly:
function FindFont(const AFacename: string): Boolean;
begin
Result := (Screen.Fonts.IndexOf(AFacename) <> -1);
end;
I would like to have a single neat (close and self contained) function (let's call it GetDesktopHandle) that returns a handle to the Desktop window. I use the code below. But it only works in the DeskHandle is a global var.
How to get rid of this global variable? If I make it local I get an AV in getDesktopWnd when I try to DeskHandle := hChild
VAR DeskHandle : HWND;
function GetDesktopHandle: HWND;
function getDesktopWnd (Handle: HWND; NotUsed: Longint): bool; stdcall; { Callback function }
VAR hChild : HWND;
begin
if handle <> 0 then
begin
hChild := FindWindowEx(handle, 0, 'SHELLDLL_DefView', nil);
if hChild <> 0 then
begin
hChild := FindWindowEx(hChild, 0, 'SysListView32', nil);
if hChild <> 0
then DeskHandle := hChild;
end;
end;
Result:= TRUE;
end;
begin
DeskHandle := 0;
EnumWindows(#getDesktopWnd, 0);
Result:= DeskHandle;
end;
The main question is: can I write this code as a single function or AT LEAST, can I get rid of the external/global var?
Possible solution:
The documentation says that the second parameter is only a IN parameter.
lParam [in]
Type: LPARAM
An application-defined value to be passed to the callback function.
https://msdn.microsoft.com/en-us/library/windows/desktop/ms633497%28v=vs.85%29.aspx
Would it be wrong to use it to pass the result back?
Local functions cannot be used as callbacks. If you hadn't used the # operator to pass your function, the compiler would have told you that. (Using the operator turns the argument into an ordinary untyped pointer, so the compiler can't check anymore.)
You'll have to make your callback be a standalone function.
To pass data between the callback and the caller, use the second parameter, which you've currently named NotUsed. For example, you could pass a pointer to a handle variable, and then the callback could dereference the pointer to return a result.
type
TMyData = record
Handle: HWND;
Pid: DWORD;
Caption: String;
ClassName: String;
end;
PMyData = ^TMyData;
function GetWindowClass(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetClassName(Handle, PChar(Result), Length(Result)));
end;
function GetWindowCaption(const Handle: HWND): String;
begin
SetLength(Result, MAX_PATH);
SetLength(Result, GetWindowText(Handle, PChar(Result), Length(Result)));
end;
function EnumChildWindowsProc(Handle: THandle; MyData: PMyData): BOOL; stdcall;
var
ClassName: String;
Caption: String;
Pid: DWORD;
begin
ClassName := GetWindowClass(Handle);
Caption := GetWindowCaption(Handle);
Result := (ClassName = 'SysListView32') and (Caption = 'FolderView');
if Result then
begin
MyData.Handle := Handle;
GetWindowThreadProcessId(Handle, MyData.Pid);
MyData.Caption := Caption;
MyData.ClassName := ClassName;
end;
// To continue enumeration, the callback function must return TRUE;
// to stop enumeration, it must return FALSE
Result := not Result;
end;
procedure TForm1.Button1Click(Sender: TObject);
var
MyData: TMyData;
begin
ZeroMemory(#MyData, SizeOf(MyData));
EnumChildWindows(GetDesktopWindow, #EnumChildWindowsProc, NativeInt(#MyData));
if MyData.Handle > 0 then
begin
ShowMessageFmt('Found Window in Pid %d', [MyData.Pid]);
end
else begin
ShowMessage('Window not found!');
end;
end;
When I run this code, the calc.exe starts, but I cannot assign the process handle to a job.
The process starts, but the handle is not valid?
Where did I go wrong?
The result of GetLastError() is always 6.
I followed this tutorial:
Inno Setup Exec() function Wait for a limited time
const
INFINITE= $FFFFFFFF;
SEE_MASK_NOASYNC= $00000100;
SEE_MASK_NOCLOSEPROCESS= $00000040;
type
TShellExecuteInfo = record
cbSize: DWORD;
fMask: Cardinal;
HWND: HWND;
lpVerb: string;
lpFile: string;
lpParameters: string;
lpDirectory: string;
nShow: Integer;
hInstApp: THandle;
lpIDList: DWORD;
lpClass: string;
hkeyClass: THandle;
dwHotKey: DWORD;
hMonitor: THandle;
hProcess: THandle;
end;
function ShellExecuteAndWait(
Filename : String;
Params : String;
WorkingDir : String;
ShowCmd : Integer
) : Integer;
var
JobObject : Thandle;
ExecInfo : TShellExecuteInfo;
ExitCode : DWORD;
begin
ExecInfo.fMask := SEE_MASK_NOCLOSEPROCESS;
ExecInfo.hwnd := 0;
ExecInfo.lpVerb := 'open';
ExecInfo.lpFile := Filename;
ExecInfo.lpParameters := Params;
ExecInfo.lpDirectory := WorkingDir;
ExecInfo.nShow := ShowCmd;
ExecInfo.cbSize := SizeOf(ExecInfo);
JobObject := CreateJobObject( '' , 'WaitJob');
ShellExecuteEx(ExecInfo);
if not AssignProcessToJobObject( JobObject , ExecInfo.hProcess ) then
begin
MsgBox( 'Error during the assign. ' + 'Error code: ' + IntToStr( GetLastError() ), mbConfirmation, MB_OK); //Returns: 6 - Invalid handler
end;
WaitForSingleObject( JobObject , INFINITE );
GetExitCodeProcess( ExecInfo.hProcess , ExitCode );
Result := ExitCode;
end;
EDIT:
More function prototypes.
function WaitForSingleObject(
hHandle : THandle;
dwMilliseconds : DWORD
) : DWORD;
external 'WaitForSingleObject#kernel32.dll stdcall';
function ShellExecuteEx(
lpExecInfo: TShellExecuteInfo
): BOOL;
external 'ShellExecuteEx{#AW}#Shell32.dll stdcall';
function AssignProcessToJobObject(
hJob : Thandle;
hProcess : Thandle
): BOOL;
external 'AssignProcessToJobObject#kernel32.dll stdcall';
function CreateJobObject(
lpSecurityAttributes,
lpName: string
): THandle;
external 'CreateJobObject{#AW}#kernel32.dll stdcall';
I need to get the volume serial number for a drive letter during an installation created with Inno Setup. I know that DLL functions can be imported into Inno, but I'm fairly new to it and having some problems getting it to work. I know that the GetVolumeInformation function in kernel32 can do what I need. Could someone show me how to import and use that functionality in an Inno script to retrieve the volume serial number?
Thanks!
Inno-Setup code::
[Code]
function GetVolumeInformation(
lpRootPathName: PChar;
lpVolumeNameBuffer: PChar;
nVolumeNameSize: DWORD;
var lpVolumeSerialNumber: DWORD;
var lpMaximumComponentLength: DWORD;
var lpFileSystemFlags: DWORD;
lpFileSystemNameBuffer: PChar;
nFileSystemNameSize: DWORD
): BOOL;
external 'GetVolumeInformationA#kernel32.dll stdcall';
function LoWord(dw: DWORD): WORD;
begin
Result := WORD(dw);
end;
function HiWord(dw: DWORD): WORD;
begin
Result := WORD((dw shr 16) and $FFFF);
end;
function WordToHex(w: WORD): string;
begin
Result := Format('%.4x', [w]);
end;
function FindVolumeSerial(const Drive: string): string;
var
FileSystemFlags: DWORD;
VolumeSerialNumber: DWORD;
MaximumComponentLength: DWORD;
begin
Result := '';
// Note on passing PChars using RemObjects Pascal Script:
// '' pass a nil PChar
// #0 pass an empty PChar
if GetVolumeInformation(
PChar(Drive),
'', // nil
0,
VolumeSerialNumber,
MaximumComponentLength,
FileSystemFlags,
'', // nil
0)
then
Result := WordToHex(HiWord(VolumeSerialNumber)) + '-' + WordToHex(LoWord(VolumeSerialNumber));
end;
function InitializeSetup(): Boolean;
begin
MsgBox(FindVolumeSerial('c:\'), mbInformation, mb_Ok);
end;
Tested with Inno-setup version 5.2.3
In Unicode versions of Inno-Setup replace PChar with PAnsiChar
Since the InnoSetup doesn't support pointers you will have to create the external library for the call of the GetVolumeInformation function. The following code samples should work for all combinations of the Delphi and InnoSetup (from the Unicode support point of view).
Here's the Delphi library code:
library VolumeInformation;
uses
Types, Classes, SysUtils, Windows;
var
SerialNumber: AnsiString;
function GetVolumeSerial(Drive: PAnsiChar): PAnsiChar; stdcall;
var
FileSystemFlags: DWORD;
VolumeSerialNumber: DWORD;
MaximumComponentLength: DWORD;
begin
SerialNumber := '';
GetVolumeInformationA(Drive, nil, 0, #VolumeSerialNumber,
MaximumComponentLength, FileSystemFlags, nil, 0);
SerialNumber := IntToHex(HiWord(VolumeSerialNumber), 4) + ' - ' +
IntToHex(LoWord(VolumeSerialNumber), 4);
Result := PAnsiChar(SerialNumber);
end;
exports
GetVolumeSerial;
end.
And here's the InnoSetup code:
[Files]
Source: "VolumeInformation.dll"; Flags: dontcopy
[Code]
function GetVolumeSerial(Drive: PAnsiChar): PAnsiChar;
external 'GetVolumeSerial#files:VolumeInformation.dll stdcall setuponly';
procedure ButtonOnClick(Sender: TObject);
var
S: string;
begin
S := GetVolumeSerial('c:\');
MsgBox(S, mbInformation, mb_Ok);
end;
I need to get a fully qualified domain name for a Windows machine on a domain in Delphi.
I've tried to use LookupAccountSid but it gives me only the netbios domain name,
in my case it is "intranet" but I need the full "intranet.companyname.com"
Any Ideas?
Try the GetUserNameEx Windows API function.
const
NameUnknown = 0;
NameFullyQualifiedDN = 1;
NameSamCompatible = 2;
NameDisplay = 3;
NameUniqueId = 6;
NameCanonical = 7;
NameUserPrincipal = 8;
NameCanonicalEx = 9;
NameServicePrincipal = 10;
NameDnsDomain = 12;
function GetUserNameExString(ANameFormat: DWORD): string;
var
Buf: array[0..256] of Char;
BufSize: DWORD;
GetUserNameEx: function (NameFormat: DWORD; lpNameBuffer: LPSTR;
var nSize: ULONG): BOOL; stdcall;
begin
Result := '';
BufSize := SizeOf(Buf) div SizeOf(Buf[0]);
GetUserNameEx := GetProcAddress(GetModuleHandle('secur32.dll'), 'GetUserNameExA');
if Assigned(GetUserNameEx) then
if GetUserNameEx(ANameFormat, Buf, BufSize) then
Result := Buf;
end;
using the NameDnsDomain format for example, will result www.mydomain.com\user_name if you are logged into "www.mydomain.com" domain.
Since I now implemented this for my own needs in our application, #iPath's comment was quit right. better use GetComputerNameEx, and specify one of the COMPUTER_NAME_FORMAT for your own needs.
A Delphi implementation would look like this (Unicode version):
interface
...
type
COMPUTER_NAME_FORMAT = (
ComputerNameNetBIOS,
ComputerNameDnsHostname,
ComputerNameDnsDomain,
ComputerNameDnsFullyQualified,
ComputerNamePhysicalNetBIOS,
ComputerNamePhysicalDnsHostname,
ComputerNamePhysicalDnsDomain,
ComputerNamePhysicalDnsFullyQualified,
ComputerNameMax);
function GetComputerNameExString(ANameFormat: COMPUTER_NAME_FORMAT): WideString;
implementation
...
function GetComputerNameExW(NameType: COMPUTER_NAME_FORMAT; lpBuffer: LPWSTR;
var nSize: DWORD): BOOL; stdcall; external kernel32 name 'GetComputerNameExW';
function GetComputerNameExString(ANameFormat: COMPUTER_NAME_FORMAT): WideString;
var
nSize: DWORD;
begin
nSize := 1024;
SetLength(Result, nSize);
if GetComputerNameExW(ANameFormat, PWideChar(Result), nSize) then
SetLength(Result, nSize)
else
Result := '';
end;
NetGetJoinInformation should work fine.
MSDN:
http://msdn.microsoft.com/en-us/library/windows/desktop/aa370423(v=vs.85).aspx
Example:
type
PWKSTA_INFO_100 = ^WKSTA_INFO_100;
WKSTA_INFO_100 = packed record
wki100_platform_id: DWord;
wki100_computername: PWChar;
wki100_langroup: PWChar;
wki100_ver_major: DWord;
wki100_ver_minor: DWord;
end;
TNetSetupJoinStatus =
(
NetSetupUnknownStatus,
NetSetupUnjoined,
NetSetupWorkgroupName,
NetSetupDomainName
);
TNetApiBufferFreeFunction = function(ABuffer: Pointer): DWORD; stdcall;
TNetWkstaGetInfoFunction = function(const AServername: PWChar; const ALevel: DWord; const ABufptr: Pointer): DWORD; stdcall;
TNetGetJoinInformationFunction = function(const AServerName: PWChar; out ANameBuffer: PWChar; out ABufferType: TNetSetupJoinStatus): DWORD; stdcall;
const
NERR_SUCCESS = 0;
function GetLocalComputerDomainName: string;
var
NetApiBuffer: Pointer;
NetApi: THandle;
NetApiBufferFree: TNetApiBufferFreeFunction;
NetWkstaGetInfo: TNetWkstaGetInfoFunction;
NetGetJoinInformation: TNetGetJoinInformationFunction;
NetSetupJoinStatus: TNetSetupJoinStatus;
NameBuffer: PWideChar;
begin
Result := '';
NetApi := LoadLibrary('netapi32.dll');
if NetApi <> 0 then
begin
NetApiBufferFree := TNetApiBufferFreeFunction( GetProcAddress(NetApi, 'NetApiBufferFree'));
NetGetJoinInformation := TNetGetJoinInformationFunction(GetProcAddress(NetApi, 'NetGetJoinInformation'));
NetWkstaGetInfo := TNetWkstaGetInfoFunction( GetProcAddress(NetApi, 'NetWkstaGetInfo'));
if #NetApiBufferFree <> nil then
begin
if #NetSetupJoinStatus <> nil then
begin
if NetGetJoinInformation(nil, NameBuffer, NetSetupJoinStatus) = NERR_SUCCESS then
begin
if NetSetupJoinStatus = NetSetupDomainName then
begin
Result := NameBuffer;
end;
NetApiBufferFree(NameBuffer);
end;
end;
end;
FreeLibrary(NetApi);
end;
end;
I tried all of the above, but without success. In the end, I settled for simply grabbing the environment variable.
uses jclSysInfo;
function GetDomain:string;
begin
result:=GetEnvironmentVariable('USERDNSDOMAIN');
end;
Tested on Server 2008 R2 - works fine. Returns "server.home.lan".
Results in an empty string on a Windows 7 non-domain connected PC.
The only correct api to use is DsGetDcName.
Because NetGetJoinInformation is still from the 'lanmanager age' so, the domain is LM compliant.
The code here is C, but you are smart enough to do the same in Delphi :)
PDOMAIN_CONTROLLER_INFOW pdomInfo ;
auto result1 = ::DsGetDcNameW(nullptr, nullptr, nullptr, nullptr, DS_DIRECTORY_SERVICE_PREFERRED | DS_RETURN_DNS_NAME, &pdomInfo);
if (result1 == ERROR_SUCCESS) {
auto retVal = SysAllocString(pdomInfo->DomainName);
::NetApiBufferFree(pdomInfo);
}