WINAPI explorer shell document "details" - windows

In a similar vein to this question, I'm after a way to pragmatically read the information in the "details" pane that is shown when you select "properties" in explorer.
For example in the screenshots below,
a few random details are circled.
i am not after a way to determine the specific items circled in some other way (eg please don't suggest how to find out the width in pixels of an image) that is not what i am after. i need a way to parse all the information that is available, for display purposes in my own program, without having to "know" about the files myself. this is simply to create a specific user interface without having to actually open up the Dialogs shown.
For what its worth, the language du jour is Delphi, but i am quite capable of translating c++ or any other dialect of winapi code, but if you happen to have delphi code, that would be a bonus for me personally.
edit: i'd like to be able to get document specific details, eg the slide count in a powerPoint document, which does not conform to the standardarized constants you need to access properties that most documents have.
i can for example get some basic information from a powerpoint document using this code (but not the slide count).
uses shellapi,ComObj;
{$R *.dfm}
const
FmtID_SummaryInformation: TGUID =
'{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
function FileTimeToDateTimeStr(F: TFileTime): string;
var
LocalFileTime: TFileTime;
SystemTime: TSystemTime;
DateTime: TDateTime;
begin
if Comp(F) = 0 then Result := '-'
else
begin
FileTimeToLocalFileTime(F, LocalFileTime);
FileTimeToSystemTime(LocalFileTime, SystemTime);
with SystemTime do
DateTime := EncodeDate(wYear, wMonth, wDay) +
EncodeTime(wHour, wMinute, wSecond, wMilliseconds);
Result := DateTimeToStr(DateTime);
end;
end;
function GetDocInfo(const FileName: WideString): string;
var
I: Integer;
PropSetStg: IPropertySetStorage;
PropSpec: array[2..19] of TPropSpec;
PropStg: IPropertyStorage;
PropVariant: array[2..19] of TPropVariant;
Rslt: HResult;
S: string;
Stg: IStorage;
begin
Result := '';
try
OleCheck(StgOpenStorage(PWideChar(FileName), nil, STGM_READ or
STGM_SHARE_DENY_WRITE,
nil, 0, Stg));
PropSetStg := Stg as IPropertySetStorage;
OleCheck(PropSetStg.Open(FmtID_SummaryInformation,
STGM_READ or STGM_SHARE_EXCLUSIVE, PropStg));
for I := 2 to 19 do
begin
PropSpec[I].ulKind := PRSPEC_PROPID;
PropSpec[I].PropID := I;
end;
Rslt := PropStg.ReadMultiple(18, #PropSpec, #PropVariant);
OleCheck(Rslt);
if Rslt <> S_FALSE then for I := 2 to 19 do
begin
S := '';
if PropVariant[I].vt = VT_LPSTR then
if Assigned(PropVariant[I].pszVal) then
S := PropVariant[I].pszVal;
case I of
2: S := Format('Title: %s', [S]);
3: S := Format('Subject: %s', [S]);
4: S := Format('Author: %s', [S]);
5: S := Format('Keywords: %s', [S]);
6: S := Format('Comments: %s', [S]);
7: S := Format('Template: %s', [S]);
8: S := Format('Last saved by: %s', [S]);
9: S := Format('Revision number: %s', [S]);
10: S := Format('Total editing time: %g sec',
[Comp(PropVariant[I].filetime) / 1.0E9]);
11: S := Format('Last printed: %s',
[FileTimeToDateTimeStr(PropVariant[I].filetime)]);
12: S := Format('Create time/date: %s',
[FileTimeToDateTimeStr(PropVariant[I].filetime)]);
13: S := Format('Last saved time/date: %s',
[FileTimeToDateTimeStr(PropVariant[I].filetime)]);
14: S := Format('Number of pages: %d', [PropVariant[I].lVal]);
15: S := Format('Number of words: %d', [PropVariant[I].lVal]);
16: S := Format('Number of characters: %d',
[PropVariant[I].lVal]);
17:; // thumbnail
18: S := Format('Name of creating application: %s', [S]);
19: S := Format('Security: %.8x', [PropVariant[I].lVal]);
else
S := Format('unknown property#%d: %s', [i,S]);
end;
if S <> '' then Result := Result + S + #13#10;
end;
finally
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
memo1.text :=GetDocInfo('C:\mypowerpoint.ppt');
end;

There are samples in C++ in the Windows 7 SDK that demonstrate property enumeration (under Samples\winui\shell\appplatform\PropertyEdit), as well as a longer demo on CodePlex.
There isn't a "canonical" list of properties, as the property system is extensible; however, the Microsoft list of properties is part of the SDK and is found in propkey.h.

Related

Allow users choose hotkeys for icon/shortcut in Inno Setup

I'm looking to allow users, who run an installer made trough Inno Setup, to choose whether to use hot keys or not, and if yes, allow them to choose which hot keys use.
[Icons]
Name: "{autoprograms}\{#MyAppName}"; Filename: "{app}\{#MyAppExeName}"; \
HotKey: "ctrl+alt+b"
Name: "{autoprograms}\{#MyAppName2}"; Filename: "{app}\{#MyAppExeName2}"; \
HotKey: "ctrl+alt+x"
This is my [Icons] section
The Icons section HotKey parameter cannot be modified at run time. So you will have to create the whole shortcut programmatically. An easy API that allows creating a shortcut with a hot key is WScript.Shell.CreateShortcut.
[Code]
var
App1HotKeyCombo: TNewComboBox;
App2HotKeyCombo: TNewComboBox;
const
NoneHotKey = 'None';
procedure InitializeWizard();
var
HotKeysPage: TWizardPage;
ALabel: TNewStaticText;
begin
Log('InitializeWizard');
HotKeysPage := CreateCustomPage(wpSelectTasks, 'Select your hot keys', '');
App1HotKeyCombo := TNewComboBox.Create(HotKeysPage);
App1HotKeyCombo.Parent := HotKeysPage.Surface;
App1HotKeyCombo.Left := ScaleX(200);
App1HotKeyCombo.Top := 0;
App1HotKeyCombo.Width := ScaleX(100);
App1HotKeyCombo.Style := csDropDownList;
App1HotKeyCombo.Items.Add(NoneHotKey);
App1HotKeyCombo.Items.Add('Ctrl+Alt+A');
App1HotKeyCombo.Items.Add('Ctrl+Alt+B');
App1HotKeyCombo.Items.Add('Ctrl+Alt+C');
App1HotKeyCombo.ItemIndex := 1;
ALabel := TNewStaticText.Create(HotKeysPage);
ALabel.Parent := HotKeysPage.Surface;
ALabel.Top := App1HotKeyCombo.Top + ScaleY(4);
ALabel.Left := 0;
ALabel.Caption := 'Hot key for application 1:';
ALabel.FocusControl := App1HotKeyCombo;
App2HotKeyCombo := TNewComboBox.Create(HotKeysPage);
App2HotKeyCombo.Parent := HotKeysPage.Surface;
App2HotKeyCombo.Left := App1HotKeyCombo.Left;
App2HotKeyCombo.Top := App1HotKeyCombo.Top + App1HotKeyCombo.Height + ScaleY(8);
App2HotKeyCombo.Width := App1HotKeyCombo.Width;
App2HotKeyCombo.Style := csDropDownList;
App2HotKeyCombo.Items.Assign(App1HotKeyCombo.Items);
App2HotKeyCombo.ItemIndex := 2;
ALabel := TNewStaticText.Create(HotKeysPage);
ALabel.Parent := HotKeysPage.Surface;
ALabel.Top := App2HotKeyCombo.Top + ScaleY(4);
ALabel.Left := 0;
ALabel.Caption := 'Hot key for application 2:';
ALabel.FocusControl := App2HotKeyCombo;
end;
procedure CreateShortCut(IconName, Path: string; AppHotKeyCombo: TNewComboBox);
var
WshShell: Variant;
ShellLink: Variant;
Msg: string;
begin
WshShell := CreateOleObject('WScript.Shell');
IconName := ExpandConstant(IconName) + '.lnk';
ShellLink := WshShell.CreateShortcut(IconName)
ShellLink.TargetPath := ExpandConstant(Path);
ShellLink.WindowStyle := SW_SHOWNORMAL;
if AppHotKeyCombo.Text <> NoneHotKey then
ShellLink.Hotkey := AppHotKeyCombo.Text;
ShellLink.Save;
Msg := 'Created "%s" icon pointing to "%s" with "%s" hotkey';
Log(Format(Msg, [IconName, ShellLink.TargetPath, ShellLink.Hotkey]));
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
if CurStep = ssInstall then
begin
CreateShortCut('{autoprograms}\MyProg1', '{app}\MyProg.exe', App1HotKeyCombo);
CreateShortCut('{autoprograms}\MyProg2', '{app}\MyProg.exe', App2HotKeyCombo);
end;
end;
A more robust API, is IShellLink. That's what Inno Setup uses internally. Though it requires considerably alot more code. For some examples, see Check for existence of a shortcut pointing to a specific target in Inno Setup.
You will also have to ensure that the shortcuts get deleted on uninstall. You can use UninstallDelete section for that.
If you do not want to code the shortcut creation, an alternative approach would be to use preprocessor to generate separate [Icons] entry for each shortcut you want to offer and use Check parameters to activate only the entry corresponding to the shortcut the user selects.

How can I add an item with icon in the system menu of a form?

This is my code that works except for the icon
procedure TForm1.FormCreate(Sender: TObject);
var item : TMenuItemInfo;
begin
with item do
begin
cbSize := SizeOf(MenuItemInfo);
fMask := MIIM_TYPE or MIIM_ID;
fType := MFT_STRING;
wID := 180;
dwTypeData := PChar('Test');
cch := 4;
hbmpItem := Image1.Picture.Bitmap.Handle; //Image1 is TImage
end;
InsertMenuItem(GetSystemMenu(Handle, FALSE),0,true,item);
end;
A couple of issues:
You don't clear the TMenuItemInfo instance before use. Unassigned fields may contain invalid or erroneous data when the call is made.
Use
ZeroMemory(#item, SizeOf(item));
at the beginning of the procedure.
The combination of fMask and fType members you have is incorrect.
Use the following instead
fMask := MIIM_STRING or MIIM_BITMAP or MIIM_ID;
// fType := MFT_STRING;
That is, don't assign fType
Here is a sample snip of a test, where a TImage holds the image depicting a number 2 on orange background. That is added as icon to the new menu item. (Which is your question)
Adding test code as requested:
// Note! Your `Image1` must have a bitmap loaded
procedure TForm39.AddSystemMenuItem;
var
item : TMenuItemInfo;
begin
ZeroMemory(#item, SizeOf(item));
with item do
begin
cbSize := SizeOf(MenuItemInfo);
fMask := MIIM_STRING or MIIM_BITMAP or MIIM_ID;
// fType := MFT_STRING;
wID := 180;
dwTypeData := PChar('Test');
cch := 4;
hbmpItem := Image1.Picture.Bitmap.Handle; //Image1 is TImage
end;
if not InsertMenuItem(GetSystemMenu(Handle, FALSE),0,true,item) then
ShowMessage('Failed');
end;
procedure TForm39.Button1Click(Sender: TObject);
begin
AddSystemMenuItem;
end;

Problem with Delphi 10.3 Community PaintBox Repaint-Function

I am currently making a little Program in Delphi 10.3 Community Version 26.0.34749.6593. No additional components.
Essentially I draw on TPaintBox which is fitted in a Panel. Everything works fine so far, but when the objects are repainted via "PaintBox1.Repaint" the Objects got the wrong BrushStyle (bsSolid when they should have bsClear e.g.) Of course I tried to pin it down, but I got no luck. But I found out that at the following Point something doesn't work:
procedure TForm1.PaintBox1Paint(Sender: TObject);
var
i: Integer;
fig : ^TFigure;
apen: TPenStyle;
abrush: TBrushStyle;
color1,color2: TColor;
begin
aPen := PaintBox1.Canvas.Pen.Style;
aBrush := bsStyle;
color1 := PaintBox1.Canvas.Brush.Color;
color2 := PaintBox1.Canvas.Pen.Color;
for I:=0 to List.Count-1 do
begin
fig := List.Items[i];
case fig.Typ of
f_Kreis : begin
with Paintbox1.Canvas do
begin
pen.Style := fig.Pen;
Brush.Style := fig.Brush;
pen.Color := fig.PenColor;
brush.Color := fig.BrushColor;
Ellipse(fig.X,fig.Y,fig.X2,fig.Y2);
end;
end;
f_Rechteck : begin
with PaintBox1.Canvas do
begin
Pen.Style := fig.Pen;
Brush.Style := fig.Brush;
Pen.Color := fig.PenColor;
Brush.Color := fig.BrushColor;
Rectangle(fig.X,fig.Y,fig.X2,fig.Y2);
end;
end;
f_Line : begin
with PaintBox1.Canvas do
begin
pen.Style := fig.Pen;
brush.Style := fig.Brush;
pen.Color := fig.PenColor;
brush.Color := fig.BrushColor;
MoveTo(fig.X,Fig.Y);
LineTo(fig.X2,fig.Y2);
end;
end;
end;
end;
PaintBox1.Canvas.Pen.Style := aPen;
bsStyle := aBrush;
PaintBox1.Canvas.Brush.Color := color1;
PaintBox1.Canvas.Pen.Color := color2;
end;
So when the "Brush.Style := fig.Brush;"-Line is called, nothing happens. I went step by step and after these Line "Brush.Style" is still "bsSolid" even when "fig.Brush" is "bsClear"
For explanation: TFigure is my own class. It houses information about a drawing, such as a rectangle. It is the parent class.
Do I miss something. I really am out of Ideas. Can anyone tell me, why nothing happens?
Edit:
For testing I added the lines:
if Brush.Style <> fig.Brush then
ShowMessage('Warnung!');
under
Brush.Style := fig.Brush;
and it actually wont set it on false, though Brush.Style is bsSolid and fig.Brush is bsClear.
You have declared fig : ^TFigure;, but class instances are already references (pointers). Thus you are creating a pointer to reference, and using that pointer as if it were the reference.
Remove the pointer operator and declare
fig: TFigure;
I can't verify whether there are other errors in your code

Downloading a file in Delphi

A google search shows a few examples on how to download a file in Delphi but most are buggy and half of the time don't work in my experience.
I'm looking for a simple robust solution which will let me download a single exe (for updating my app) and will hold the execution of the current update thread until the download is done or errors out. The process is already threaded so the download code should hold execution until it's done (hopefully).
Here's two implementations, both seem very complicated
1. http://www.scalabium.com/faq/dct0116.htm
2. http://delphi.about.com/od/internetintranet/a/get_file_net.htm
Why not make use of Indy? If you use the TIdHTTP component, it's simple:
procedure TMyForm.DownloadFile;
var
IdHTTP1: TIdHTTP;
Stream: TMemoryStream;
Url, FileName: String;
begin
Url := 'http://www.rejbrand.se';
Filename := 'download.htm';
IdHTTP1 := TIdHTTP.Create(Self);
Stream := TMemoryStream.Create;
try
IdHTTP1.Get(Url, Stream);
Stream.SaveToFile(FileName);
finally
Stream.Free;
IdHTTP1.Free;
end;
end;
You can even add a progress bar by using the OnWork and OnWorkBegin events:
procedure TMyForm.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode;AWorkCountMax: Int64);
begin
ProgressBar.Max := AWorkCountMax;
ProgressBar.Position := 0;
end;
procedure TMyForm.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
begin
ProgressBar.Position := AWorkCount;
end;
procedure TMyForm.DownloadFile;
var
IdHTTP1: TIdHTTP;
Stream: TMemoryStream;
Url, FileName: String;
begin
Url := 'http://www.rejbrand.se';
Filename := 'download.htm';
IdHTTP1 := TIdHTTP.Create(Self);
Stream := TMemoryStream.Create;
try
IdHTTP1.OnWorkBegin := IdHTTPWorkBegin;
IdHTTP1.OnWork := IdHTTPWork;
IdHTTP1.Get(Url, Stream);
Stream.SaveToFile(FileName);
finally
Stream.Free;
IdHTTP1.Free;
end;
end;
I'm not sure if these events fire in the context of the main thread, so any updates done to VCL components may have to be done using the TIdNotify component to avoid threading issues. Maybe someone else can check that.
The second approach is the standard way of using Internet resources using WinINet, a part of Windows API. I have used it a lot, and it has always worked well. The first approach I have never tried. (Neither is "very complicated". There will always be a few additional steps when using the Windows API.)
If you want a very simple method, you could simply call UrlMon.URLDownloadToFile. You will not get any fine control (at all!) about the download, but it is very simple.
Example:
URLDownloadToFile(nil,
'http://www.rejbrand.se',
PChar(ExtractFilePath(Application.ExeName) + 'download.htm'),
0,
nil);
For people that has later version of delphi, you can use this:
var
http : TNetHTTPClient;
url : string;
stream: TMemoryStream;
begin
http := TNetHTTPClient.Create(nil);
stream := TMemoryStream.Create;
try
url := YOUR_URL_TO_DOWNLOAD;
http.Get(url, stream);
stream.SaveToFile('D:\Temporary\1.zip');
finally
stream.Free;
http.Free;
end;
end;
Using URLMon.
errcode := URLMon.URLDownloadToFile(nil,
PChar('http://www.vbforums.com/showthread.php?345726-DELPHI-Download-Files'),
PChar( 'a:\download.htm'),
0,
nil);
if errcode > 0 then
showmessage('Error while downloading: ' + inttostr(errcode));

create windows user using Delphi

I need to create new windows user as administrator using Delphi
Thanks
you can use the NetUserAdd and NetUserSetGroups functions declarated in the JEDI Headers.
see this simple sample.
program ProjectAddNewUser;
{$APPTYPE CONSOLE}
uses
JclWin32,//Jedi Library
Windows,
SysUtils;
function CreateWinUser(const wServer, wUsername, wPassword, wGroup:WideString): Boolean;
var
Buf : USER_INFO_2;//Buf for the new user info
Err : NET_API_STATUS;
ParmErr : DWORD;
GrpUsrInfo: USER_INFO_0;//Buf for the group
wDummyStr : WideString;
begin
wDummyStr:='';
FillChar (Buf, SizeOf(USER_INFO_2), 0);
with Buf do
begin
usri2_name := PWideChar(wUsername);
usri2_full_name := PWideChar(wUsername);//You can add a more descriptive name here
usri2_password := PWideChar(wPassword);
usri2_comment := PWideChar(wDummyStr);
usri2_priv := USER_PRIV_USER;
usri2_flags := UF_SCRIPT OR UF_DONT_EXPIRE_PASSWD;
usri2_script_path := PWideChar(wDummyStr);
usri2_home_dir := PWideChar(wDummyStr);
usri2_acct_expires:= TIMEQ_FOREVER;
end;
GrpUsrInfo.usri0_name:=PWideChar(wGroup);
Err := NetUserAdd(PWideChar(wServer), 1, #Buf, #ParmErr);
Result := (Err = NERR_SUCCESS);
if Result then //NOw you must set the group for the new user
begin
Err := NetUserSetGroups(PWideChar(wServer),PWideChar(wGroup),0,#GrpUsrInfo,1);
Result := (Err = NERR_SUCCESS);
end;
end;
begin
if CreateWinUser('localhost', 'MyNewUser','ThePassword','MyWindowsGroup') then
Writeln('Ok')
else
Writeln('False');
Readln;
end.
I think the API call you need is NetUserAdd.
First, check if Delphi provides a wrapper for this call. If not, you'll have to write your own. If you don't know how to make Windows API calls from Delphi, you have some more research to do.

Resources