I'm not a genius when it comes to DLL's or Handles, but I have a project which involves both put together. The projects include an EXE and a DLL. The EXE is used to manage installing, in particular installing a Windows Service. The DLL inclues all the necessary functionality to manage Windows Services. I have the functions in the DLL which perform the actual install/uninstall, start/stop, check if installed, check if running, etc. This is all to make it easy to implement in one app, as well as re-use it across multiple apps. If possible, I'd like to make sure it's compatible with other development languages too.
My problem is passing a Handle (HWND) as a parameter in one of the DLL functions. I need to execute a windows command line, and the method I'm using requires it. It worked perfectly when this function was together in the main app, but since I moved it into the DLL, it is giving access violation.
On the other hand, I have another function in the DLL which for sure is supposed to return True, but always returns False. Please let me know if I'm doing anything wrong here...
WinSvc32Lib.dll:
WinSvc32.exe:
JD Solutions
My problem is passing a Handle (HWND) as a parameter in one of the DLL functions. I need to execute a windows command line, and the method I'm using requires it. It worked perfectly when this function was together in the main app, but since I moved it into the DLL, it is giving access violation.
On the other hand, I have another function in the DLL which for sure is supposed to return True, but always returns False. Please let me know if I'm doing anything wrong here...
WinSvc32Lib.dll:
Code:
library WinSvc32Lib;
uses
ShareMem,
Windows,
SysUtils,
Classes,
Messages,
Forms,
Dialogs,
StrUtils,
Registry,
ShellAPI,
Controls;
{$R *.res}
//----------------------------------------------------------------------------------------------------------
//This function is always returning false, even though in previous code returns true properly
//Could it have to do with using PChar? I'm using PChar instead of String to be compatible with other languages.
function svc_ServiceIsInstalled(Filename: PChar): Bool; StdCall;
var
Reg: TRegistry;
L: TStringList;
Key, N: PChar;
X: Integer;
begin
Result:= False;
Reg:= TRegistry.Create(KEY_READ or KEY_WRITE);
L:= TStringList.Create;
try
Reg.RootKey:= HKEY_LOCAL_MACHINE;
Key:= 'System\CurrentControlSet\Services';
Reg.OpenKey(Key, False);
Reg.GetKeyNames(L);
Reg.CloseKey;
for X:= 0 to L.Count - 1 do begin
N:= PChar(L[X]);
Reg.OpenKey(Key+'\'+N, False);
if Reg.ValueExists('ImagePath') then begin
if UpperCase(Filename) = UpperCase(Reg.ReadString('ImagePath')) then
Result:= True;
end;
Reg.CloseKey;
end;
finally
Reg.Free;
L.Free;
end;
end;
function svc_ServiceIsRunning(Filename: PChar): Bool; StdCall;
begin
end;
//----------------This function is raising an Access Violation----------------
function svc_InstallService(Filename: PChar; Handle: HWND): Bool; StdCall;
var
L: TStringList;
Dir: String;
FN: String;
sei: TShellExecuteInfo;
begin
Result:= True;
Dir:= ExtractFilePath(Filename);
FN:= ExtractFileName(Filename);
if RightStr(Dir, 1) <> '\' then Dir:= Dir + '\';
L:= TStringList.Create;
try
L.Append(FN+' /install');
L.SaveToFile(Dir+'_InstSvc.bat');
try
ZeroMemory(@sei, sizeof(sei));
with sei do
begin
cbSize:= SizeOf(sei);
fMask:= SEE_MASK_INVOKEIDLIST;
Wnd:= Handle;
lpVerb:= 'open';
lpFile:= PChar('_InstSvc.bat');
lpDirectory := PChar(Dir);
nShow := SW_HIDE;
end;
ShellExecuteEX(@sei);
except
on e: exception do begin
Result:= False;
MessageDlg('Failed to install service: '+e.Message, mtError, [mbOK], 0);
end;
end;
finally
L.Free;
end;
end;
//----------------This function is raising an Access Violation----------------
function svc_UninstallService(Filename: PChar; Handle: HWND): Bool; StdCall;
var
L: TStringList;
Dir: String;
FN: String;
sei: TShellExecuteInfo;
begin
Result:= True;
Dir:= ExtractFilePath(Filename);
FN:= ExtractFileName(Filename);
if RightStr(Dir, 1) <> '\' then Dir:= Dir + '\';
L:= TStringList.Create;
try
L.Append(FN+' /uninstall');
L.SaveToFile(Dir+'_InstSvc.bat');
try
ZeroMemory(@sei, sizeof(sei));
with sei do
begin
cbSize:= SizeOf(sei);
fMask:= SEE_MASK_INVOKEIDLIST;
Wnd:= Handle;
lpVerb:= 'open';
lpFile:= PChar('_InstSvc.bat');
lpDirectory := PChar(Dir);
nShow := SW_HIDE;
end;
ShellExecuteEX(@sei);
except
on e: exception do begin
Result:= False;
MessageDlg('Failed to uninstall service: '+e.Message, mtError, [mbOK], 0);
end;
end;
finally
L.Free;
end;
end;
function svc_StartService(Filename: PChar; Handle: HWND): Bool; StdCall;
begin
end;
function svc_StopService(Filename: PChar; Handle: HWND): Bool; StdCall;
begin
end;
exports
svc_ServiceIsInstalled,
svc_ServiceIsRunning,
svc_InstallService,
svc_UninstallService,
svc_StartService,
svc_StopService;
begin
end.WinSvc32.exe:
Code:
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, Buttons, XPMan, Registry, StrUtils, ShellAPI, ExtCtrls;
type
TfrmWinSvc32 = class(TForm)
txtFilename: TEdit;
Label2: TLabel;
cmdBrowse: TBitBtn;
dlgOpen: TOpenDialog;
XPManifest1: TXPManifest;
cmdInstall: TBitBtn;
cmdAbout: TBitBtn;
Panel1: TPanel;
Label1: TLabel;
procedure cmdBrowseClick(Sender: TObject);
procedure cmdInstallClick(Sender: TObject);
procedure cmdAboutClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
//function SvcInstalled(Filename: String): Bool;
procedure AcceptFiles(var msg: TMessage);
message WM_DROPFILES;
end;
var
frmWinSvc32: TfrmWinSvc32;
function svc_ServiceIsInstalled(Filename: PChar): Bool;
External 'WinSvc32Lib.dll';
function svc_ServiceIsRunning(Filename: PChar): Bool;
External 'WinSvc32Lib.dll';
function svc_InstallService(Filename: PChar; Handle: HWND): Bool;
External 'WinSvc32Lib.dll';
function svc_UninstallService(Filename: PChar; Handle: HWND): Bool;
External 'WinSvc32Lib.dll';
function svc_StartService(Filename: PChar; Handle: HWND): Bool;
External 'WinSvc32Lib.dll';
function svc_StopService(Filename: PChar; Handle: HWND): Bool;
External 'WinSvc32Lib.dll';
implementation
uses uAbout;
{$R *.dfm}
procedure TfrmWinSvc32.AcceptFiles(var msg: TMessage);
const
cnMaxFileNameLen = 255;
var
i, nCount: integer;
acFileName: array [0..cnMaxFileNameLen] of char;
begin
try
try
nCount:= DragQueryFile(msg.WParam, $FFFFFFFF, acFileName, cnMaxFileNameLen);
if nCount = 1 then begin
//for i := 0 to nCount-1 do
//begin
i:= 0;
DragQueryFile(msg.WParam, i, acFileName, cnMaxFileNameLen);
//ShowMessage(acFileName);
if UpperCase(RightStr(acFileName, 4)) = '.EXE' then begin
if FileExists(acFileName) then begin
dlgOpen.FileName:= acFileName;
txtFilename.Text:= acFileName;
if svc_ServiceIsInstalled(acFileName) then begin
cmdInstall.Caption:= 'Uninstall';
cmdInstall.Hint:= 'Uninstall selected service';
end else begin
cmdInstall.Caption:= 'Install';
cmdInstall.Hint:= 'Install selected service';
end;
cmdInstall.Enabled:= True;
end else begin
raise Exception.Create('Specified file does not exist.');
end;
end else begin
raise Exception.Create('Only executable (.exe) files can be installed.');
end;
//end;
end else begin
raise Exception.Create('Only one service can be installed at a time.');
end;
except
on e: exception do begin
MessageDlg('Error opening file(s): '+e.Message, mtError, [mbOK], 0);
end;
end;
finally
DragFinish(msg.WParam);
end;
end;
procedure TfrmWinSvc32.cmdBrowseClick(Sender: TObject);
var
Inst: Bool;
begin
if dlgOpen.Execute then begin
if FileExists(dlgOpen.FileName) then begin
txtFilename.Text:= dlgOpen.FileName;
Inst:= svc_ServiceIsInstalled(PChar(dlgOpen.FileName));
if Inst then begin
cmdInstall.Caption:= 'Uninstall';
cmdInstall.Hint:= 'Uninstall selected service';
end else begin
cmdInstall.Caption:= 'Install';
cmdInstall.Hint:= 'Install selected service';
end;
cmdInstall.Enabled:= True;
end;
end;
end;
procedure TfrmWinSvc32.cmdInstallClick(Sender: TObject);
var
Dir: String;
FN: String;
sei: TShellExecuteInfo;
Res: Bool;
begin
Dir:= ExtractFilePath(txtFilename.Text);
FN:= ExtractFileName(txtFilename.Text);
if RightStr(Dir, 1) <> '\' then Dir:= Dir + '\';
try
if cmdInstall.Caption = 'Install' then begin
Res:= svc_InstallService(PChar(FN), Handle);
end else begin
Res:= svc_UninstallService(PChar(FN), Handle);
end;
finally
cmdInstall.Caption:= 'Install';
cmdInstall.Enabled:= False;
cmdBrowse.Enabled:= True;
txtFilename.Enabled:= True;
txtFilename.Clear;
txtFilename.SetFocus;
end;
end;
procedure TfrmWinSvc32.cmdAboutClick(Sender: TObject);
begin
frmAbout.ShowModal;
{ShowMessage('This utility is used to install or uninstall windows services.'+#10+
'First, browse and select the Service Executable (.exe) you wish to use.'+#10+
'If service is installed, it will offer to Uninstall.'+#10+
'If service is not installed, it will offer to Install.'); }
end;
procedure TfrmWinSvc32.FormCreate(Sender: TObject);
begin
DragAcceptFiles(Handle, True);
end;
end.JD Solutions