From my Win32 app I'm reading and writing HKEY_CURRENT_USER\Software\Embarcadero\BDS\9.0\History Lists\hlRunParameters, that is where the Delphi XE2 IDE writes run-time parameters.
This is the write code:
procedure TFrmCleanIDEParams.BtnWriteClick(Sender: TObject);
var
lReg : TRegistry;
lValue,
lKey : String;
i,
lNrToWrite,
lNrRegVals: Integer;
begin
.....
lKey := Trim(EdtRegKey.Text); // '\Software\Embarcadero\BDS\9.0\History Lists\hlRunParameters'
if lKey = '' then Exit;
if lKey[1] = '\' then lKey := Copy(lKey,2);
lReg := TRegistry.Create(KEY_READ or KEY_WRITE);
lReg.RootKey := HKEY_CURRENT_USER;
if not lReg.OpenKey(lKey,false) then
begin
MessageDlg('Key not found', mtError, mbOKCancel, 0);
Exit;
end;
if not lReg.ValueExists('Count') then
begin
MessageDlg('Value ''Count'' not found', mtError, mbOKCancel, 0);
Exit;
end;
lNrRegVals := lReg.ReadInteger('Count');
lNrToWrite := CLBParams.Items.Count; // TCheckListBox
lReg.WriteInteger('Count',lNrToWrite);
for i := 0 to lNrToWrite-1 do
begin
lValue := 'Item' + IntToStr(i);
lReg.WriteString(lValue,CLBParams.Items[i]);
end;
// Remove the rest:
for i := lNrToWrite to lNrRegVals-1 do
lReg.DeleteValue('Item' + IntToStr(i));
end;
Issues:
In RegEdit I see the key contents changing as expected, but the Delphi IDE does not pick up these changes
Some time (reboot?) later the HKEY_CURRENT_USER key has its old values
I think several things could be the reason, but I'm not sure which ones to attack:
I should not use HKEY_CURRENT_USER, but HKEY_USERS. If this is the case, how do I then get the proper S-1-5-etc that I need to use?
It's a Windows 7 64-bit issue, although both my program and the Delphi IDE are 32 bit. (How) do I then need to change the TRegistry.Create?
I read this Delphi: Read 64-bits registry key from 32-bits process post but that still does not tell me if/when to use different 'access keys'.
Do I always need to use this KEY_WOW64_64KEY value regardless of my app being 32/64 bit? I see that HKEY_CURRENT_USER\Software is shared, not redirected. (How) do I need to treat these differently?
BTW UAC is off, it would be nice if my code worked with UAC on too.
The Delphi IDE will only read these values at start up. But you must make sure that you write the registry values after the IDE has finished writing to them.
You should be using HKEY_CURRENT_USER.
You should not be using an alternate registry view flag because that part of the registry is shared.
UAC won't have any impact here because HKEY_CURRENT_USER is writeable for the standard user token.
The only explanation that makes sense is that another process is modifying the values. My guess is that the Delphi IDE is that process.
Related
My program has a TWebBrowser where the user can open all kinds of local documents. To avoid that for example a Word document is opened in Word instead of in the TWebBrowser (that is to say, in Internet Explorer), I successfully use a fix in the Registry, by executing a .reg file with this instruction:
[HKEY_LOCAL_MACHINE\SOFTWARE\Classes\Word.Document.12]
"BrowserFlags"=dword:80000024
I am trying to introduce that instruction in the Delphi program itself, with this code:
procedure RegOpenExplorer;
var
reg: TRegistry;
begin
reg:= TRegistry.Create;
try
reg.RootKey:=HKEY_LOCAL_MACHINE;
reg.OpenKey('SOFTWARE\Classes\Word.Document.12\', true);
reg.WriteInteger('BrowserFlags',80000024);
reg.CloseKey;
finally
reg.Free;
end;
end;
It does not work, actually the effect is undoing the fix.
When successfully manipulated with the .reg file (or manually), the Registry key looks like this:
But with my unsuccessful Delphi Code, the key becomes as follows:
The difference is the number in brackets, but that is something that the Registry introduces automatically by itself.
The numeric value in the .reg file is encoded as hex. Since you are passing an integer literal to WriteInteger(), you need to prefix it with a $ to make the compiler interpret it as hex:
reg.WriteInteger('BrowserFlags', $80000024);
That being said, note that you are writing to HKEY_LOCAL_MACHINE, and more importantly you are opening the key with KEY_ALL_ACCESS access rights (the default access rights that TRegistry uses). This is going to require you to run your app elevated as an administrator, if it is not already. You should be setting the TRegistry.Access property to KEY_SET_VALUE instead, and maybe even writing to HKEY_CURRENT_USER instead.
procedure RegOpenExplorer;
var
reg: TRegistry;
begin
reg := TRegistry.Create(KEY_SET_VALUE);
try
reg.RootKey := HKEY_LOCAL_MACHINE; // or HKEY_CURRENT_USER
if reg.OpenKey('SOFTWARE\Classes\Word.Document.12\', true) then
try
reg.WriteInteger('BrowserFlags', $80000024);
finally
reg.CloseKey;
end;
finally
reg.Free;
end;
end;
I am trying to copy a file to the clipboard. All examples in Internet are the same. I am using one from, http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212186.html but it does not work.
I use Rad Studio XE and I pass the complete path. In mode debug, I get some warnings like:
Debug Output:
Invalid address specified to RtlSizeHeap( 006E0000, 007196D8 )
Invalid address specified to RtlSizeHeap( 006E0000, 007196D8 )
I am not sure is my environment is related: Windows 8.1 64 bits, Rad Studio XE.
When I try to paste the clipboard, nothing happens. Also, seeing the clipboard with a monitor tool, this tool shows me error.
The code is:
procedure TfrmDoc2.CopyFilesToClipboard(FileList: string);
var
DropFiles: PDropFiles;
hGlobal: THandle;
iLen: Integer;
begin
iLen := Length(FileList) + 2;
FileList := FileList + #0#0;
hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + iLen);
if (hGlobal = 0) then raise Exception.Create('Could not allocate memory.');
begin
DropFiles := GlobalLock(hGlobal);
DropFiles^.pFiles := SizeOf(TDropFiles);
Move(FileList[1], (PChar(DropFiles) + SizeOf(TDropFiles))^, iLen);
GlobalUnlock(hGlobal);
Clipboard.SetAsHandle(CF_HDROP, hGlobal);
end;
end;
UPDATE:
I am sorry, I feel stupid. I used the code that did not work, the original question that somebody asked, in my project, while I used the Remy's code, the correct solution, here in Stackoverflow. I thought that I used the Remy's code in my project. So, now, using the Remy's code, everything works great. Sorry for the mistake.
The forum post you link to contains the code in your question and asks why it doesn't work. Not surprisingly the code doesn't work for you any more than it did for the asker.
The answer that Remy gives is that there is a mismatch between ANSI and Unicode. The code is for ANSI but the compiler is Unicode.
So click on Remy's reply and do what it says: http://embarcadero.newsgroups.archived.at/public.delphi.nativeapi/200909/0909212187.html
Essentially you need to adapt the code to account for characters being 2 bytes wide in Unicode Delphi, but I see no real purpose repeating Remy's code here.
However, I'd say that you can do better than this code. The problem with this code is that it mixes every aspect all into one big function that does it all. What's more, the function is a method of a form in your GUI which is really the wrong place for it. There are aspects of the code that you might be able to re-use, but not factored like that.
I'd start with a function that puts an known block of memory into the clipboard.
procedure ClipboardError;
begin
raise Exception.Create('Could not complete clipboard operation.');
// substitute something more specific that Exception in your code
end;
procedure CheckClipboardHandle(Handle: HGLOBAL);
begin
if Handle=0 then begin
ClipboardError;
end;
end;
procedure CheckClipboardPtr(Ptr: Pointer);
begin
if not Assigned(Ptr) then begin
ClipboardError;
end;
end;
procedure PutInClipboard(ClipboardFormat: UINT; Buffer: Pointer; Count: Integer);
var
Handle: HGLOBAL;
Ptr: Pointer;
begin
Clipboard.Open;
Try
Handle := GlobalAlloc(GMEM_MOVEABLE, Count);
Try
CheckClipboardHandle(Handle);
Ptr := GlobalLock(Handle);
CheckClipboardPtr(Ptr);
Move(Buffer^, Ptr^, Count);
GlobalUnlock(Handle);
Clipboard.SetAsHandle(ClipboardFormat, Handle);
Except
GlobalFree(Handle);
raise;
End;
Finally
Clipboard.Close;
End;
end;
We're also going to need to be able to make double-null terminated lists of strings. Like this:
function DoubleNullTerminatedString(const Values: array of string): string;
var
Value: string;
begin
Result := '';
for Value in Values do
Result := Result + Value + #0;
Result := Result + #0;
end;
Perhaps you might add an overload that accepted a TStrings instance.
Now that we have all this we can concentrate on making the structure needed for the CF_HDROP format.
procedure CopyFileNamesToClipboard(const FileNames: array of string);
var
Size: Integer;
FileList: string;
DropFiles: PDropFiles;
begin
FileList := DoubleNullTerminatedString(FileNames);
Size := SizeOf(TDropFiles) + ByteLength(FileList);
DropFiles := AllocMem(Size);
try
DropFiles.pFiles := SizeOf(TDropFiles);
DropFiles.fWide := True;
Move(Pointer(FileList)^, (PByte(DropFiles) + SizeOf(TDropFiles))^,
ByteLength(FileList));
PutInClipboard(CF_HDROP, DropFiles, Size);
finally
FreeMem(DropFiles);
end;
end;
Since you use Delphi XE, strings are Unicode, but you are not taking the size of character into count when you allocate and move memory.
Change the line allocating memory to
hGlobal := GlobalAlloc(GMEM_SHARE or GMEM_MOVEABLE or GMEM_ZEROINIT,
SizeOf(TDropFiles) + iLen * SizeOf(Char));
and the line copying memory, to
Move(FileList[1], (PByte(DropFiles) + SizeOf(TDropFiles))^, iLen * SizeOf(Char));
Note the inclusion of *SizeOf(Char) in both lines and change of PChar to PByte on second line.
Then, also set the fWide member of DropFiles to True
DropFiles^.fWide := True;
All of these changes are already in the code from Remy, referred to by David.
I need to call an external program from Delphi 2006 code with a long list of arguments, specifically to concatenate mutiple PDFs into one file using PDFTK. The full string to be executed has over 512 characters, but both WinExec and ShellExecute have a 512 character limit.
Are there any alternatives to these procedures that have much larger limits?
Just use a temporary BATCH file, containing the commands to be executed.
This will allow also some enhanced features, like calling several PDFTK instance in a row, add backup or copy of files, just in the same process.
Run the batch as SW_SHOWMINIMIZED to have no black console window pop up.
Just found this #SwissDelphiCentre, which seems to work nicely:
procedure ShellExecute_AndWait(FileName: string; Params: string);
var
exInfo: TShellExecuteInfo;
Ph: DWORD;
begin
FillChar(exInfo, SizeOf(exInfo), 0);
with exInfo do
begin
cbSize := SizeOf(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
Wnd := GetActiveWindow();
ExInfo.lpVerb := 'open';
ExInfo.lpParameters := PChar(Params);
lpFile := PChar(FileName);
nShow := SW_SHOWNORMAL;
end;
if ShellExecuteEx(#exInfo) then
Ph := exInfo.HProcess
else
begin
ShowMessage(SysErrorMessage(GetLastError));
Exit;
end;
while WaitForSingleObject(ExInfo.hProcess, 50) <> WAIT_OBJECT_0 do
Application.ProcessMessages;
CloseHandle(Ph);
end;
There are some limits on the length of the names passed to ShellExecute, but these are typically greater than 512 characters. It seems you just need to dynamically allocate the names rather than using a static char array.
If you want to go to the ultimate command line length then you can use CreateProcess which has a limit of 32,768 characters.
As another option you could consider writing the list of arguments to a temporary file. Then you would modify the external program so that it is capable of being passed the path to that file as its command line argument. You would obviously need to also modify the external program so that it could read the file and obtain the long list of files from the temporary file.
I can't use the XPS API since the program has to be able to print on Windows XP.
I'm trying to set the paper size from Letter to A4 using WinSpool.
This is my test code:
var
H : THandle;
I : TBytes;
Info : PPrinterInfo2;
NeededSize : DWORD;
DevMode : PDeviceMode;
PD : TPrinterDefaults;
begin
PD.pDatatype := nil;
PD.pDevMode := nil;
PD.DesiredAccess := PRINTER_ACCESS_ADMINISTER;
if not OpenPrinter('Brother HL-5350DN series Printer', H, #PD) then begin
raise Exception.Create('OpenPrinter error: ' + SysErrorMessage(GetLastError));
end;
try
Assert(not GetPrinter(H, 2, nil, 0, #NeededSize));
SetLength(I, NeededSize);
Info := #I[0];
if not GetPrinter(H, 2, Info, NeededSize, #NeededSize) then begin
raise Exception.Create('GetPrinter error: ' + SysErrorMessage(GetLastError));
end;
DevMode := Info.pDevMode;
DevMode.dmFields := DevMode.dmFields or DM_PAPERSIZE;
DevMode.dmPaperSize := DMPAPER_A4;
Info.pSecurityDescriptor := nil; // According to MSDN it has to be niled if we're not going to change it.
if not SetPrinter(H, 2, Info, 0) then begin
raise Exception.Create('SetPrinter error: ' + SysErrorMessage(GetLastError));
end;
finally
ClosePrinter(H);
end;
TPrintDialog.Create(Self).Execute; // This is just so I can check the paper size
end;
I have two problems related to access rights.
If I set PD.DesiredAccess to PRINTER_ACCESS_ADMINISTER the GetPrinter call fails, I guess this is due to UAC.
If I set it to PRINTER_ACCESS_USE the GetPrinter call succeeds and the Info structure is fine, but the call to SetPrinter fails.
Interestingly enough when I ignore the Result of SetPrinter the print dialog reports A4 as the printer size even though SetPrinter fails.
Am I doing it completly wrong and it is enough to pass a correctly setup up PDeviceMode to OpenPrinter? (I actually came up with this after writing this question :-)
Another question regarding the VCL:
If I use the Printers unit how do I know how big the buffers have to be that get passed as parameters to the TPrinter.GetPrinter method?
Background:
The system is: Windows 7 Professional 64-Bit English with English locale.
I'm trying to print to A4 paper on a network printer (Brother HL-5350DN).
I have set all printer settings in the control panel to A4 paper, but the Delphi 2009 program I'm writing still gets the paper dimensions for US Letter.
In other words: The Delphi program doesn't respect the default settings of the printer spooler.
If I run a TPrinterDialog first and select the correct paper size from there manually (in the advanced printer settings) everything is fine.
The program has to run without any UI, so I have to solve this programmatically or preferably the program should just respect the default Windows printer spooler settings.
Maybe I have missed some imporant setting?
try this guys
it work for me
uses WinSpool,Windows,System;
procedure SetPrinterInfo(APrinterName: PChar);
var
HPrinter : THandle;
InfoSize,
BytesNeeded: Cardinal;
DevMode : PDeviceMode;
PI2: PPrinterInfo2;
PrinterDefaults: TPrinterDefaults;
begin
with PrinterDefaults do
begin
DesiredAccess := PRINTER_ACCESS_USE;
pDatatype := nil;
pDevMode := nil;
end;
if OpenPrinter(APrinterName, HPrinter, #PrinterDefaults) then
try
SetLastError(0);
//Determine the number of bytes to allocate for the PRINTER_INFO_2 construct...
if not GetPrinter(HPrinter, 2, nil, 0, #BytesNeeded) then
begin
//Allocate memory space for the PRINTER_INFO_2 pointer (PrinterInfo2)...
PI2 := AllocMem(BytesNeeded);
try
InfoSize := SizeOf(TPrinterInfo2);
if GetPrinter(HPrinter, 2, PI2, BytesNeeded, #BytesNeeded) then
begin
DevMode := PI2.pDevMode;
DevMode.dmFields := DevMode.dmFields or DM_PAPERSIZE;
DevMode.dmPaperSize := DMPAPER_A4;
PI2.pSecurityDescriptor := nil;
// Apply settings to the printer
if DocumentProperties(0, hPrinter, APrinterName, PI2.pDevMode^,
PI2.pDevMode^, DM_IN_BUFFER or DM_OUT_BUFFER) = IDOK then
begin
SetPrinter(HPrinter, 2, PI2, 0); // Ignore the result of this call...
end;
end;
finally
FreeMem(PI2, BytesNeeded);
end;
end;
finally
ClosePrinter(HPrinter);
end;
end;
Like David wrote, my specific problem is solved by setting the correct printer preferences in Windows.
I still haven't found a way to set the local printing properties for my application, but that is no longer necessary.
Like Sertac wrote you can read and write the global printer preferences using TPrinter.GetPrinter and TPrinter.SetPrinter. (See the comments to the question)
Since nobody provided an anwser and the problem is now solved, I'm marking this as community wiki. Feel free to improve this answer.
I've heard that some custom component authors use an RTL routine that checks to see if Delphi is running in order to set up shareware restrictions. Does anyone know what this routine is? Checking obvious names like "DelphiRunning" or "IsDelphiRunning" doesn't turn up anything useful.
There are 2 different ideas here:
- Delphi is up and running
- The application is running under the debugger
The common way to test if Delphi is running is to check the presence of known IDE Windows which have a specific classname like TAppBuilder or TPropertyInspector.
Those 2 works in all version of Delphi IIRC.
If you want to know if your application is running under the debugger, i.e. launched normally from the IDE with "Run" (F9) or attached to the debugger while already running, you just have to test the DebugHook global variable.
Note that "Detach from program" does not remove the DebugHook value, but "Attach to process" sets it.
function IsDelphiRunning: Boolean;
begin
Result := (FindWindow('TAppBuilder', nil) > 0) and
(FindWindow('TPropertyInspector', 'Object Inspector') > 0);
end;
function IsOrWasUnderDebugger: Boolean;
begin
Result := DebugHook <> 0;
end;
If the goal is to restrict the use of a trial version of your component to when the application is being developped, both have flaws:
- Hidden windows with the proper Classname/Title can be included in the application
- DebugHook can be manually set in the code
You can use DebugHook <> 0 from your component code. DebugHook is a global variable (IIRC, it's in the Systems unit) that's set by the Delphi/RAD Studio IDE, and couldn't be set from anywhere else.
There are other techniques (FindWindow() for TAppBuilder, for instance), but DebugHook takes all of the work out of it.
This is a code snippet from www.delphitricks.com/source-code/misc/check_if_delphi_is_running.html.
function WindowExists(AppWindowName, AppClassName: string): Boolean;
var
hwd: LongWord;
begin
hwd := 0;
hwd := FindWindow(PChar(AppWindowName), PChar(AppClassName));
Result := False;
if not (Hwd = 0) then {window was found if not nil}
Result := True;
end;
function DelphiLoaded: Boolean;
begin
DelphiLoaded := False;
if WindowExists('TPropertyInspector', 'Object Inspector') then
if WindowExists('TMenuBuilder', 'Menu Designer') then
if WindowExists('TAppBuilder', '(AnyName)') then
if WindowExists('TApplication', 'Delphi') then
if WindowExists('TAlignPalette', 'Align') then
DelphiLoaded := True;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if DelphiLoaded then
begin
ShowMessage('Delphi is running');
end;
end;
function DelphiIsRunning: Boolean;
begin
Result := DebugHook <> 0;
end;