kjkim
/
BSOne.SFC
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity
BSOne.SFC/eCrmHE/EXE_ServiceInstaller/DSvcInstMain.pas

359 lines
10 KiB
Plaintext
Raw Blame History

This file contains ambiguous Unicode characters

This file contains Unicode characters that might be confused with other characters. If you think that this is intentional, you can safely ignore this warning. Use the Escape button to reveal them.

unit DSvcInstMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls;
const
INI_CONFIG = 'ServiceInstall.ini';
type
TDlgSvcInstMain = class(TForm)
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
edSvcName: TEdit;
edDisplayName: TEdit;
edPath: TEdit;
cbSvcType: TComboBox;
cbStartType: TComboBox;
btnStatus: TButton;
btnInstall: TButton;
btnDelete: TButton;
Label6: TLabel;
lbStatus: TLabel;
btnStart: TButton;
btnStop: TButton;
chInstallStart: TCheckBox;
chStayOnTop: TCheckBox;
chInteractive: TCheckBox;
procedure btnInstallClick(Sender: TObject);
procedure btnDeleteClick(Sender: TObject);
procedure btnStatusClick(Sender: TObject);
procedure btnStartClick(Sender: TObject);
procedure btnStopClick(Sender: TObject);
procedure chStayOnTopClick(Sender: TObject);
procedure cbSvcTypeChange(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
Constructor Create(aOwner: TComponent); override;
Destructor Destroy; override;
procedure SaveInput;
procedure LoadInput;
procedure UpdateStatus;
end;
var
DlgSvcInstMain: TDlgSvcInstMain;
implementation
uses
Tocsg.Service, Tocsg.Controls, Winapi.WinSvc, System.IniFiles, Tocsg.Safe,
Tocsg.Path;
{$R *.dfm}
Constructor TDlgSvcInstMain.Create(aOwner: TComponent);
begin
Inherited Create(aOwner);
LoadInput;
UpdateStatus;
end;
Destructor TDlgSvcInstMain.Destroy;
begin
Inherited;
end;
procedure TDlgSvcInstMain.SaveInput;
var
ini: TIniFile;
begin
Guard(ini, TIniFile.Create(GetRunExePathDir + INI_CONFIG));
ini.WriteString('RecentInfo', 'Name', edSvcName.Text);
ini.WriteString('RecentInfo', 'Display', edDisplayName.Text);
ini.WriteString('RecentInfo', 'Path', edPath.Text);
ini.WriteInteger('RecentInfo', 'Type', cbSvcType.ItemIndex);
ini.WriteInteger('RecentInfo', 'Mode', cbStartType.ItemIndex);
ini.WriteBool('RecentInfo', 'InstallAfter', chInstallStart.Checked);
end;
procedure TDlgSvcInstMain.LoadInput;
var
sPath: String;
ini: TIniFile;
begin
sPath := GetRunExePathDir + INI_CONFIG;
if FileExists(sPath) then
begin
Guard(ini, TIniFile.Create(sPath));
edSvcName.Text := ini.ReadString('RecentInfo', 'Name', '');
edDisplayName.Text := ini.ReadString('RecentInfo', 'Display', '');
edPath.Text := ini.ReadString('RecentInfo', 'Path', '');
cbSvcType.ItemIndex := ini.ReadInteger('RecentInfo', 'Type', -1);
cbStartType.ItemIndex := ini.ReadInteger('RecentInfo', 'Mode', -1);
chInstallStart.Checked := ini.ReadBool('RecentInfo', 'InstallAfter', false);
Application.ProcessMessages;
end;
end;
procedure TDlgSvcInstMain.btnDeleteClick(Sender: TObject);
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
begin
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20≯<EFBFBD><CCB8><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
edSvcName.SetFocus;
exit;
end;
case GetServiceStatus(edSvcName.Text) of
0 :
begin
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʴ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD>Դϴ<D4B4>.', PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
SERVICE_RUNNING,
SERVICE_CONTINUE_PENDING,
SERVICE_START_PENDING :
if not ServiceStop(edSvcName.Text) then
begin
MessageBox(Handle, '<27><><EFBFBD>񽺸<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>ϴ<EFBFBD><CFB4><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD><CFBF><EFBFBD><EFBFBD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
end;
if UninstallService(edSvcName.Text) then
begin
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>ſ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD><CFBF><EFBFBD><EFBFBD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONINFORMATION or MB_OK);
SaveInput;
UpdateStatus;
end else
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>ſ<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD><CFBF><EFBFBD><EFBFBD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONSTOP or MB_OK);
end;
procedure TDlgSvcInstMain.btnInstallClick(Sender: TObject);
var
dwSvcType: DWORD;
nStartMode: Integer;
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
begin
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20≯<EFBFBD><CCB8><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
edSvcName.SetFocus;
exit;
end;
if edDisplayName.Text = '' then
begin
MessageBox(Handle, 'ǥ<><C7A5> <20≯<EFBFBD><CCB8><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
edDisplayName.SetFocus;
exit;
end;
if edPath.Text = '' then
begin
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD>θ<EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
edPath.SetFocus;
exit;
end;
if not FileExists(edPath.Text) then
begin
MessageBox(Handle, '<27><><EFBFBD>ο<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
edPath.SetFocus;
exit;
end;
if cbSvcType.ItemIndex = -1 then
begin
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ֽʽÿ<CABD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
cbSvcType.SetFocus;
exit;
end;
if cbStartType.ItemIndex = -1 then
begin
MessageBox(Handle, '<27><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>ֽʽÿ<CABD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
cbStartType.SetFocus;
exit;
end;
case cbSvcType.ItemIndex of
0 : dwSvcType := SERVICE_KERNEL_DRIVER;
1 : dwSvcType := SERVICE_FILE_SYSTEM_DRIVER;
2 : dwSvcType := SERVICE_ADAPTER;
3 : dwSvcType := SERVICE_RECOGNIZER_DRIVER;
4 : dwSvcType := SERVICE_DRIVER;
5 : dwSvcType := SERVICE_WIN32_OWN_PROCESS;
6 : dwSvcType := SERVICE_WIN32_SHARE_PROCESS;
7 : dwSvcType := SERVICE_WIN32;
8 : dwSvcType := SERVICE_INTERACTIVE_PROCESS;
else begin
MessageBox(Handle, '<27>߸<EFBFBD><DFB8><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Դϴ<D4B4>.', PChar(Caption), MB_ICONWARNING or MB_OK);
cbSvcType.SetFocus;
exit;
end;
end;
case dwSvcType of
5, 6 :
if chInteractive.Checked then
dwSvcType := dwSvcType or SERVICE_INTERACTIVE_PROCESS;
end;
case cbStartType.ItemIndex of
0 : nStartMode := SERVICE_BOOT_START;
1 : nStartMode := SERVICE_SYSTEM_START;
2 : nStartMode := SERVICE_AUTO_START;
3 : nStartMode := SERVICE_DEMAND_START;
4 : nStartMode := SERVICE_DISABLED;
else begin
MessageBox(Handle, '<27>߸<EFBFBD><DFB8><EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Դϴ<D4B4>.', PChar(Caption), MB_ICONWARNING or MB_OK);
cbStartType.SetFocus;
exit;
end;
end;
if InstallService(edSvcName.Text, edPath.Text, edDisplayName.Text,
dwSvcType, nStartMode) then
begin
MessageBox(Handle, '<27><>ġ<EFBFBD><C4A1> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD><CFBF><EFBFBD><EFBFBD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONINFORMATION or MB_OK);
if chInstallStart.Checked then
if not ServiceStart(edSvcName.Text) then
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>߻<EFBFBD><DFBB>Ͽ<EFBFBD><CFBF><EFBFBD><EFBFBD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
SaveInput;
UpdateStatus;
end else
MessageBox(Handle, '<27><>ġ<EFBFBD><C4A1> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD><CFBF><EFBFBD><EFBFBD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONSTOP or MB_OK);
end;
procedure TDlgSvcInstMain.btnStartClick(Sender: TObject);
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
begin
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20≯<EFBFBD><CCB8><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
edSvcName.SetFocus;
exit;
end;
case GetServiceStatus(edSvcName.Text) of
0 :
begin
MessageBox(Handle, '<27><><EFBFBD>񽺰<EFBFBD> <20><>ġ<EFBFBD>Ǿ<EFBFBD> <20><><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
SERVICE_RUNNING,
SERVICE_CONTINUE_PENDING,
SERVICE_START_PENDING :
begin
MessageBox(Handle, '<27>̹<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Դϴ<D4B4>..', PChar(Caption), MB_ICONINFORMATION or MB_OK);
exit;
end;
end;
if ServiceStart(edSvcName.Text) then
UpdateStatus
else
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD><CFBF><EFBFBD><EFBFBD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONSTOP or MB_OK);
end;
procedure TDlgSvcInstMain.btnStopClick(Sender: TObject);
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
begin
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20≯<EFBFBD><CCB8><EFBFBD> <20>Է<EFBFBD><D4B7><EFBFBD> <20>ֽʽÿ<CABD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
edSvcName.SetFocus;
exit;
end;
case GetServiceStatus(edSvcName.Text) of
0 :
begin
MessageBox(Handle, '<27><><EFBFBD>񽺰<EFBFBD> <20><>ġ<EFBFBD>Ǿ<EFBFBD> <20><><EFBFBD><EFBFBD> <20>ʽ<EFBFBD><CABD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
exit;
end;
SERVICE_STOPPED,
SERVICE_STOP_PENDING :
begin
MessageBox(Handle, '<27>̹<EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20>Դϴ<D4B4>..', PChar(Caption), MB_ICONINFORMATION or MB_OK);
exit;
end;
end;
if ServiceStop(edSvcName.Text) then
UpdateStatus
else
MessageBox(Handle, '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD><EFBFBD>Ͽ<EFBFBD><CFBF><EFBFBD><EFBFBD>ϴ<EFBFBD>.', PChar(Caption), MB_ICONWARNING or MB_OK);
end;
procedure TDlgSvcInstMain.cbSvcTypeChange(Sender: TObject);
begin
case cbSvcType.ItemIndex of
5, 6 : chInteractive.Enabled := true;
else chInteractive.Enabled := false;
end;
end;
procedure TDlgSvcInstMain.chStayOnTopClick(Sender: TObject);
begin
if chStayOnTop.Checked then
FormStyle := fsStayOnTop
else
FormStyle := fsNormal;
end;
procedure TDlgSvcInstMain.btnStatusClick(Sender: TObject);
begin
UpdateStatus;
end;
procedure TDlgSvcInstMain.UpdateStatus;
begin
edSvcName.Text := Trim(edSvcName.Text);
edDisplayName.Text := Trim(edDisplayName.Text);
edPath.Text := Trim(edPath.Text);
if edSvcName.Text = '' then
exit;
case GetServiceStatus(edSvcName.Text) of
SERVICE_STOPPED : lbStatus.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>. (SERVICE_STOPPED)';
SERVICE_START_PENDING : lbStatus.Caption := '<27><><EFBFBD><EFBFBD> <20>ϴ<EFBFBD><CFB4><EFBFBD>.. (SERVICE_START_PENDING)';
SERVICE_STOP_PENDING : lbStatus.Caption := '<27><><EFBFBD><EFBFBD> <20>ϴ<EFBFBD><CFB4><EFBFBD>.. (SERVICE_STOP_PENDING)';
SERVICE_RUNNING : lbStatus.Caption := '<27><><EFBFBD>۵<EFBFBD>. (SERVICE_RUNNING)';
SERVICE_CONTINUE_PENDING : lbStatus.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>.. (SERVICE_CONTINUE_PENDING)';
SERVICE_PAUSE_PENDING : lbStatus.Caption := '<27><><EFBFBD><EFBFBD> <20>ϴ<EFBFBD><CFB4><EFBFBD>.. (SERVICE_PAUSE_PENDING)';
SERVICE_PAUSED : lbStatus.Caption := '<27><><EFBFBD><EFBFBD><EFBFBD><EFBFBD>. (SERVICE_PAUSED)';
else lbStatus.Caption := '<27><>ġ<EFBFBD>Ǿ<EFBFBD> <20><><EFBFBD><EFBFBD> <20><><EFBFBD><EFBFBD>.';
end;
Application.ProcessMessages;
end;
end.
Reference in New Issue View Git Blame Copy Permalink