I am using Kaspersky Internet Security 2018. But when I compile my Delphi application with these codes, my anti-virus application will remove the compiled exe:
function BrowseForFolder(var dpFolder: String; dpTitle: String): Boolean;
var
dpBrowseInfo: TBrowseInfo;
dpDisplayName: array[0..255] of Char;
dpItemIDList: PItemIDList;
begin
FillChar(dpBrowseInfo, sizeof(dpBrowseInfo), #0);
with dpBrowseInfo do begin
hwndOwner := Application.Handle;
pszDisplayName := #dpDisplayName[0];
lpszTitle := PChar(dpTitle);
dpItemIDList := SHBrowseForFolder(dpBrowseInfo);
ulFlags := BIF_RETURNONLYFSDIRS and BIF_VALIDATE;
end;
if Assigned(dpItemIDList) then begin
if SHGetPathFromIDList(dpItemIDList, dpDisplayName) then begin
dpFolder := dpDisplayName;
Result := True;
end else begin
Result := False;
end;
end;
end;
What should I do to pop up "Browse folder" menu other than adding my app to whitelist?
I have tried every "Browse Folder" dialog types and I have realized that my anti-virus software only allows Vcl.FileCtrl.TSelectDirExtOpt (also it hates other FileCtrl dialogs).
So, I fixed my issue myself like this:
procedure TForm1.gözatDüğmesiClick(Sender: TObject);
begin
if not (menü4CB = '1') then begin
if not (SelectDirectory('Kurulum programının yedekleneceği klasörü seçin',
GetSpecialFolderPathFromCSIDL($0011), adres, [sdNewFolder, sdNewUI], nil) = False) then begin
adresÇubuğu.Text := adres;
end else begin
end;
end;
end;
Thank Remy Lebeau anyway for caring about me.
Related
I would like to modernize the GUI of my Delphi 7 App, I have already .manifest file and it looks quite good, but the Fileopen dialogs are terrible. How the make them modern?
I am using this code at the moment.
What would it require to use e.g. IFileOpenDialog instead, how to compile the header for that, or any tweaks to dialogs.pas ?
FileOpenDialog := TOpenDialog.create(parent);
FileOpenDialog.DefaultExt := '*.x';
FileOpenDialog.Filter := 'my|*.x|Text File (CSV)|*.csv';
FileOpenDialog.options := [ofHideReadOnly,ofFileMustExist ,ofNoChangeDir,ofPathMustExist ];
if FileOpenDialog.Execute then begin
// do my tricks with FileOpenDialog.filename
FormUpdate;
end;
The following example code of IFileDialog cannot be compiled with D7:
var
FolderDialog : IFileDialog;
hr: HRESULT;
IResult: IShellItem;
FileName: PChar;
Settings: DWORD;
begin
if Win32MajorVersion >= 6 then
begin
hr := CoCreateInstance(CLSID_FileOpenDialog,
nil,
CLSCTX_INPROC_SERVER,
IFileDialog,
FolderDialog);
if hr = S_OK then
begin
FolderDialog.SetOkButtonLabel(PChar('Select'));
FolderDialog.SetTitle(PChar('Select a Directory'));
hr := FolderDialog.Show(Handle);
if hr = S_OK then
begin
hr := FolderDialog.GetResult(IResult);
if hr = S_OK then
begin
IResult.GetDisplayName(SIGDN_FILESYSPATH,FileName);
ConfigPathEdit.Text := FileName;
end;
end;
end;
end;
I used this one, I tested it with D7.
// uses commdlg
function OpenSaveFileDialog( Parent: TWinControl;
const DefExt,Filter,InitialDir,Title: string;
var FileName: string;
MustExist,OverwritePrompt,NoChangeDir,DoOpen: Boolean): Boolean;
var ofn: TOpenFileName;
szFile: array[0..MAX_PATH] of Char;
begin
Result := False;
FillChar(ofn, SizeOf(TOpenFileName), 0);
with ofn do
begin
lStructSize := SizeOf(TOpenFileName);
hwndOwner := Parent.Handle;
lpstrFile := szFile;
nMaxFile := SizeOf(szFile);
if (Title <> '') then
lpstrTitle := PChar(Title);
if (InitialDir <> '') then
lpstrInitialDir := PChar(InitialDir);
StrPCopy(lpstrFile, FileName);
lpstrFilter := PChar(StringReplace(Filter, '|', #0,[rfReplaceAll, rfIgnoreCase])+#0#0);
if DefExt <> '' then
lpstrDefExt := PChar(DefExt);
end;
if MustExist then
ofn.Flags := ofn.Flags or OFN_FILEMUSTEXIST;
if OverwritePrompt then
ofn.Flags := ofn.Flags or OFN_OVERWRITEPROMPT;
if NoChangeDir then
ofn.Flags := ofn.Flags or OFN_NOCHANGEDIR;
if DoOpen
then begin
if GetOpenFileName(ofn) then
begin
Result := True;
FileName := StrPas(szFile);
end;
end
else begin
if GetSaveFileName(ofn) then
begin
Result := True;
FileName := StrPas(szFile);
end;
end;
end;
procedure TForm1.Button1Click(Sender: TObject);
VAR FilSelez : String;
begin
If OpenSaveFileDialog(Form1,'','*.*','c:\windows','',FilSelez,False,False,True,True) Then
Edit1.Text := FilSelez;
end;
Instead of using the IFileDialog interface you can also just modify Delphi's 7 Dialogs.pas file to display the "modern" dialogs.
First make a backup copy of the Dialogs.pas file in the Source\VCL folder under the Delphi installation directory. Then search the file for the term OFN_ENABLEHOOK. The complete line should be Flags := OFN_ENABLEHOOK;. Comment out the line. Add a new line Flags := 0; directly below.
Now search for the term OFN_ENABLETEMPLATE. Two lines above this should be an if Template <> nil then statement. Comment out this statement and all following ones up to and including hWndOwner := Application.Handle; and add the line hWndOwner := Screen.ActiveForm.Handle;.
Now make sure to replace the precompiled units Dialogs.dcu in the Lib and SLib directory under the Delphi installation directory with newly compiled Dialogs.dcu containing the changes. In the Lib directory you store a version without debug information, while the SLib directory contains a version with debug information. Make backup copies of the files before replacing them.
Please take note that the instructions given above only apply to Delphi 7. Furthermore, the code disables event handling for the common dialog components.
I am having one Delphi XE2 project to work something with registry key. So I have defined the following codes :
procedure TMainForm.BitBtn01Click(Sender: TObject);
var
RegistryEntry: TRegistry;
begin
RegistryEntry := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
RegistryEntry.RootKey:= HKEY_LOCAL_MACHINE;
if (not RegistryEntry.KeyExists('Software\MyCompanyName\MyName\')) then
begin
RegistryEntry.Access:= KEY_WRITE or KEY_WOW64_64KEY;
RegistryEntry.OpenKey('Software\MyCompanyName\MyName\',True);
RegistryEntry.WriteString('', 'MyFirstProject');
end
else
begin
Memo01.Lines.Add(RegistryEntry.ReadString('(Default)')); //Not Working
Memo01.Lines.Add(RegistryEntry.ReadString('')); //Not Working
Memo01.Lines.Add(RegistryEntry.ReadString('#')); //Not Working
end;
RegistryEntry.CloseKey();
RegistryEntry.Free;
end;
My requirement is to check the Default Value of "MyName" and to show in Memo01. But nothing is heppening. So I have tried another way as follows :
procedure TMainForm.BitBtn01Click(Sender: TObject);
var
RegistryEntry: TRegistry;
RegistryString: string;
begin
RegistryEntry := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
RegistryEntry.RootKey:= HKEY_LOCAL_MACHINE;
if (not RegistryEntry.KeyExists('Software\MyCompanyName\MyName\')) then
begin
RegistryEntry.Access:= KEY_WRITE or KEY_WOW64_64KEY;
RegistryEntry.OpenKey('Software\MyCompanyName\MyName\',True);
RegistryEntry.WriteString('', 'MyFirstProject');
end
else
begin
RegistryString := RegistryEntry.ReadString('(Default)'); //Not Working
RegistryString := RegistryEntry.ReadString(''); //Not Working
RegistryString := RegistryEntry.ReadString('#'); //Not Working
Memo01.Lines.Add(RegistryString);
end;
RegistryEntry.CloseKey();
RegistryEntry.Free;
end;
But it is also not working.
There is no Openkey in your else part.
Const
C_KEY='Software\MyCompanyName\MyName\';
var
RegistryEntry: TRegistry;
RegistryString: string;
begin
RegistryEntry := TRegistry.Create(KEY_READ or KEY_WOW64_64KEY);
try
RegistryEntry.RootKey := HKEY_LOCAL_MACHINE;
if (not RegistryEntry.KeyExists(C_KEY)) then
begin
RegistryEntry.Access := KEY_WRITE or KEY_WOW64_64KEY;
if RegistryEntry.OpenKey(C_KEY, true) then
RegistryEntry.WriteString('', 'MyFirstProject');
end
else
begin
RegistryEntry.Access := KEY_READ or KEY_WOW64_64KEY;
if RegistryEntry.OpenKey(C_KEY, false) then
begin
Memo01.Lines.Add(RegistryEntry.ReadString(''));
end;
end;
RegistryEntry.CloseKey();
finally
RegistryEntry.Free;
end;
end;
You might want to consider using HKEY_CURRENT_USER instead of HKEY_LOCAL_MACHINE.
In Vista/7/8, unless the program is run using administrator rights, you don't actually get HKEY_LOCAL_MACHINE, you get a virtualized location. Essentially, Windows gives you something only that user can see.
Using HKEY_LOCAL_MACHINE only leads to headaches later on. Windows has been locking that down.
Using the code below I try to set a value in the HKEY_LOCAL_MACHINE section of registry but I get an error 'Failed to set data for.....'
If I use HKEY_CURRENT_USER there is no problem.
What might I be missing here.
(The code is not complete, but I think it is the important parts of it)
type
TTypWinBits = (Bit32, Bit64);
function WinBits: TTypWinBits;
type
TIsWow64Process = function(Handle:THandle; var IsWow64 : BOOL) : BOOL; stdcall;
var
hKernel32 : Integer;
IsWow64Process : TIsWow64Process;
IsWow64 : BOOL;
begin
Result := Bit32;
hKernel32 := LoadLibrary('kernel32.dll');
if (hKernel32 = 0) then RaiseLastOSError;
#IsWow64Process := GetProcAddress(hkernel32, 'IsWow64Process');
if Assigned(IsWow64Process) then
begin
IsWow64 := False;
if (IsWow64Process(GetCurrentProcess, IsWow64)) then
Result := Bit64
else
RaiseLastOSError;
end;
FreeLibrary(hKernel32);
end;
function TFastRegistry.CreateConnection: TRegistry;
begin
Result := TRegistry.Create;
try
case WinBits of
Bit32: Result := TRegistry.Create;
Bit64: Result := TRegistry.Create(KEY_WRITE OR KEY_WOW64_64KEY);
end;
except
on E: exception do
Result := nil;
end;
end;
procedure TFastRegistry.RunAdd(aDesc, aName: string);
var
Reg: TRegistry;
sRegKey: String;
begin
sRegKey := 'Software\Microsoft\Windows\CurrentVersion\Run';
Reg := CreateConnection;
with Reg do
begin
try
RootKey := HKEY_LOCAL_MACHINE;
if not KeyExists(sRegKey) then
OpenKey(sRegKey, True)
else
OpenKey(sRegKey, False);
WriteString(aDesc, aName);
finally
CloseKey;
Free;
end;
end;
end;
A program requires elevated privileges to write to the local-machine key. Without that, functions will fail, as you've observed. If your program is supposed to be an administrative tool, then use a manifest file so the OS will prompt for permission. If you don't need that, then write to the current-user key instead so it doesn't affect all accounts on the system.
You just need to release the handle by the "Free" and for the next entry in the register to recreate it, and not keep it permanently set up and open and close them through OpenKey and CloseKey! It looks like a bug :-)
Is there support in the Delphi XE VCL for ensuring only a single instance of an application is running?
In the past, I've used library code to control a Mutex which has always seemed complicated. As I'm starting a new project in Delphi XE, I wonder if I need to dig up that old code, or if there is support built into XE already? Or is there another easy to apply code that is nice and modern?
You create a named Mutex when you start the application. Check GetLastError to see if an other instance is already running.
Put this code right after "begin" in your DPR file. Replace the GUID with one of your own. When I need a text constant that's unlikely to be used for anything else, I usually just hit Ctrl+G to get a GUID!
if CreateMutex(nil, True, '6EACD0BF-F3E0-44D9-91E7-47467B5A2B6A') = 0 then
RaiseLastOSError;
if GetLastError = ERROR_ALREADY_EXISTS then
Exit;
It might look like the code is leaking an handle because it's not saving the return of CreateMutex. It's not. Windows will automatically release the handle when our application is terminated, and that's absolutely fine with us.
I use JCL to do this:
program MyProgram;
uses
JclAppInst;
begin
JclAppInstances.CheckSingleInstance; // Added instance checking
Application.Initialize;
Application.CreateForm(TMainForm, MainForm);
Application.Run;
end.
Documentation for this, and the notification scheme, is at the JCL Wiki.
I use this, works in XE2 through to Alexandria, has the benefit of being able to bring the currently running instance to the front.
Those that say it shouldn't do that, well, given the last thing the user did was to try launch the app, bringing a currently running instance to the front makes sense
unit CheckPrevious;
interface
uses
Windows, SysUtils, WinSock;
function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;
implementation
type
PInstanceInfo = ^TInstanceInfo;
TInstanceInfo = packed record
PreviousHandle : THandle;
RunCounter : integer;
end;
var
MappingHandle: THandle;
InstanceInfo: PInstanceInfo;
MappingName : string;
RemoveMe : boolean = True;
function RestoreIfRunning(const AppHandle : THandle; MaxInstances : integer = 1) : boolean;
begin
Result := True;
MappingName := StringReplace(ParamStr(0),'\','',[rfReplaceAll, rfIgnoreCase]);
MappingHandle := CreateFileMapping($FFFFFFFF,nil,PAGE_READWRITE,0,SizeOf(TInstanceInfo),PChar(MappingName));
if MappingHandle = 0 then
RaiseLastOSError
else
begin
if GetLastError <> ERROR_ALREADY_EXISTS then
begin
InstanceInfo := MapViewOfFile(MappingHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TInstanceInfo));
InstanceInfo^.PreviousHandle := AppHandle;
InstanceInfo^.RunCounter := 1;
Result := False;
end
else //already runing
begin
MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
if MappingHandle <> 0 then
begin
InstanceInfo := MapViewOfFile(MappingHandle,FILE_MAP_ALL_ACCESS,0,0,SizeOf(TInstanceInfo));
if InstanceInfo^.RunCounter >= MaxInstances then
begin
RemoveMe := False;
if IsIconic(InstanceInfo^.PreviousHandle) then
ShowWindow(InstanceInfo^.PreviousHandle, SW_RESTORE);
SetForegroundWindow(InstanceInfo^.PreviousHandle);
end
else
begin
InstanceInfo^.PreviousHandle := AppHandle;
InstanceInfo^.RunCounter := 1 + InstanceInfo^.RunCounter;
Result := False;
end
end;
end;
end;
end;
initialization
finalization
//remove one instance
if RemoveMe then
begin
MappingHandle := OpenFileMapping(FILE_MAP_ALL_ACCESS, False, PChar(MappingName));
if MappingHandle <> 0 then
begin
InstanceInfo := MapViewOfFile(MappingHandle, FILE_MAP_ALL_ACCESS, 0, 0, SizeOf(TInstanceInfo));
InstanceInfo^.RunCounter := -1 + InstanceInfo^.RunCounter;
end
else
RaiseLastOSError;
end;
if Assigned(InstanceInfo) then
UnmapViewOfFile(InstanceInfo);
if MappingHandle <> 0 then
CloseHandle(MappingHandle);
end.
In your project DPR, add the CheckPrevious unit to the uses, then just after begin put the following
if RestoreIfRunning(Application.Handle, 1) then
Exit;
I have no idea of where this code originated, otherwise I would gladly credit the author. (A search of RestoreIfRunning may suggest it was from Zarko Gajic)
This is how i do it.
closeProc(extractfilename(paramstr(0)));
function TForm1.closeProc(pname : string): integer;
const
PROCESS_TERMINATE = $0001;
var
ContinueLoop: BOOL;
FSnapshotHandle: THandle;
FProcessEntry32: TProcessEntry32;
i : integer;
pname2 : string;
begin
try
Result := 0;
i := 0;
FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
while Integer(ContinueLoop) <> 0 do
begin
pname2 := trim(UpperCase(ExtractFileName(FProcessEntry32.szExeFile)));
if ( pname2 = uppercase(pname)) then
if FProcessEntry32.th32ProcessID <> GetCurrentProcessId then
begin
Result := Integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0), FProcessEntry32.th32ProcessID), 0));
inc(i);
end;
ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
if i > 50 then
break;
end;
CloseHandle(FSnapshotHandle);
except
end;
end;
Has anyone got any hints that will allow me to integrate the Microsoft Help Viewer with a Delphi Application (2009 onwards).
Thanks
You can have a look at Introducing MS Help Viewer 1.0 and Microsoft Help System Documentation
i assume you mean HtmlHelp, since WinHelp is deprecated, and stopped shipping with Windows 5 years ago.
Here's the code i add to my ApplicationEvents object's OnHelp event handler:
function TdmGlobal.ApplicationEvents1Help(Command: Word; Data: Integer;
var CallHelp: Boolean): Boolean;
var
HelpFile: string;
LocalFile: string;
HCommand : word;
begin
CallHelp := False;
Result := False;
//i've named the help file the same as the executable, but with CHM extension
HelpFile := ChangeFileExt(Application.ExeName, '.chm');
if not FileExists(HelpFile) then
Exit;
//Starting in 2003 HtmlHelp will no longer work from a network drive.
//Copy the file to the local machine's temp folder if it's sitting on a network share
if PathIsNetworkPath(HelpFile) then
begin
LocalFile := IncludeTrailingBackslash(GetTemporaryPath)+ExtractFilename(HelpFile);
if (not FileExists(LocalFile)) then
begin
try
CopyFile(PChar(HelpFile), PChar(LocalFile), False);
except
Exit;
end;
end
else
begin
if (GetUncompressedFileSize(HelpFile) <> GetUncompressedFileSize(LocalFile)) then
try
CopyFile(PChar(HelpFile), PChar(LocalFile), False);
except
//Exit; eat it
end;
end;
HelpFile := LocalFile;
end;
{translate WinHelp --> HTMLHelp}
case Command of
HELP_CONTENTS:
begin
HCommand := HH_DISPLAY_TOC;
Data := 0;
end; {HELP_CONTENTS..}
HELP_CONTEXT : HCommand := HH_HELP_CONTEXT;
HELP_CONTEXTPOPUP : HCommand := HH_HELP_CONTEXT;
HELP_FINDER : HCommand := HH_DISPLAY_TOPIC;
HELP_KEY : HCommand := HH_DISPLAY_INDEX;
HELP_QUIT :
begin
HCommand := HH_CLOSE_ALL;
Data := 0;
end; {HELP_QUIT..}
else
begin {default}
HCommand := HH_DISPLAY_TOPIC;
Data := 0;
end; {default..}
end; {case Command..}
hhCtrl.HtmlHelp(GetDesktopWindow(), HelpFile, HCommand, Data);
end;
With hhCtrl.pas containing a number of constants, as well as the function:
function HtmlHelp(
hwndCaller: HWND;
szFile: AnsiString;
uCommand: UINT;
dwData: DWORD): HWND; stdcall; external 'hhctrl.ocx' name 'HtmlHelpA'; {external API call}