Aşağıda yaptım servis uygulamamın bir kısmı mevcut.
Burada şöyle bir sorun yaşıyorum. ilk kurulumumda servisim düzgün bir şekilde çalışıyor.
Serverı kapatıp açtığımızda veya yeniden başlattığımızda servis çalışıyor fakat veritabanına bağlanamıyor.
Servisi restart ettiğimde sorun çözülüyor. Bu durum istisnasız her yeniden başlatmada yaşanıyor.
connect olduğum kısma log kaydı yazdırdım ne hata alıyorum diye. Aşağıdaki hatayı veriyor yalnızca.
EUniError, Named Pipes Provider: Could not open a connection to SQL Server [2].
Kod: Tümünü seç
unit unMain;
interface
uses
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes,
Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, IniFiles,
Registry, ActiveX, Uni, UniProvider, SQLServerUniProvider,
Data.DB, MemDS, DBAccess, IdSMTP, IdMessage, IdText, IdAttachmentFile;
type
TTimerThread = class(TThread)
private
FTickEvent: THandle;
protected
procedure Execute; override;
public
constructor Create(CreateSuspended: Boolean);
destructor Destroy; override;
procedure FinishThreadExecution;
end;
type
TEmailService = class(TService)
db: TUniConnection;
procedure ServiceAfterInstall(Sender: TService);
procedure ServiceAfterUninstall(Sender: TService);
procedure ServiceCreate(Sender: TObject);
procedure ServiceDestroy(Sender: TObject);
private
FTimerThread: TTimerThread;
{ Private declarations }
public
PATH,
DBUserName,
DBPassword,
ServerName,
LDatabase,
LFirmNo,
LPeriodNo,
FHost,
FPort,
FUserName,
FPassword,
FFromAddress,
PDFFile: string;
function GetServiceController: TServiceController; override;
procedure Conn;
procedure ReadConfig;
procedure SendPDFFile;
{ Public declarations }
end;
var
EmailService: TEmailService;
ini: TCustomIniFile;
implementation
{$R *.dfm}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
EmailService.Controller(CtrlCode);
end;
procedure TEmailService.Conn;
var
Connection, ALogFile: string;
SList: TStringList;
begin
SList := TStringList.Create;
try
try
if not DirectoryExists(PATH + 'Log', True) then
begin
CreateDir(PATH + 'Log');
end;
ALogFile := PATH + 'Log\' +
'EmailService-Log-' + FormatDateTime('dd-mm-yyy', Date()) + '.txt';
if not FileExists(ALogFile) then
begin
SList.SaveToFile(ALogFile);
end;
Connection := 'Login Prompt=False' + ';' +
'Provider Name=SQL Server' + ';' +
'Data Source=' + ServerName + ';' +
'User ID=' + DBUserName + ';' +
'Password=' + DBPassword + ';' +
'Initial Catalog=' + LDatabase;
with db do
begin
Port := 1433;
ConnectString := Connection;
SpecificOptions.Values['ApplicationName'] := 'EMail_Service';
Connect;
end;
except
on E: Exception do
begin
SList.LoadFromFile(ALogFile);
SList.Add(E.ClassName + ' , ' + E.Message);
SList.SaveToFile(ALogFile);
end;
end;
finally
SList.Free;
end;
end;
function TEmailService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TEmailService.ReadConfig;
begin
ini := TIniFile.Create(Path + 'System\dbconfig.cfg');
try
DBUserName := ini.ReadString('DatabaseSettings', 'DBUserName', '');
DBPassword := ini.ReadString('DatabaseSettings', 'DBPassword', '');
ServerName := ini.ReadString('DatabaseSettings', 'ServerName', '');
LDatabase := ini.ReadString('DatabaseSettings', 'LDatabase', '');
LFirmNo := ini.ReadString('DatabaseSettings', 'LFirmNo', '');
LPeriodNo := ini.ReadString('DatabaseSettings', 'LPeriodNo', '');
FHost := ini.ReadString('EMailSettings', 'Host', '');
FPort := ini.ReadString('EMailSettings', 'Port', '');
FUserName := ini.ReadString('EMailSettings', 'UserName', '');
FPassword := ini.ReadString('EMailSettings', 'Password', '');
FFromAddress := ini.ReadString('EMailSettings', 'FromAddress', '');
PDFFile := ini.ReadString('AppSettings', 'PDFFile', '');
finally
ini.Free;
end;
end;
procedure TEmailService.SendPDFFile;
begin
// process
end;
procedure TEmailService.ServiceAfterInstall(Sender: TService);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
if Reg.OpenKey('\SYSTEM\CurrentControlSet\services\' + Name, False) then
begin
Reg.WriteString('Description', 'E-Mail Service.');
Reg.CloseKey;
end;
finally
Reg.Free;
end;
end;
procedure TEmailService.ServiceAfterUninstall(Sender: TService);
var
Reg: TRegistry;
begin
Reg := TRegistry.Create(KEY_READ or KEY_WRITE);
try
Reg.RootKey := HKEY_LOCAL_MACHINE;
Reg.DeleteKey('SYSTEM\CurrentControlSet\services\' + Name);
finally
FreeAndNil(Reg);
end;
end;
procedure TEmailService.ServiceCreate(Sender: TObject);
begin
DisplayName := 'Email Service';
PATH := ExtractFilePath(ParamStr(0));
ReadConfig;
Conn;
FTimerThread := TTimerThread.Create(False);
end;
procedure TEmailService.ServiceDestroy(Sender: TObject);
begin
FTimerThread.FinishThreadExecution;
end;
{ TTimerThread }
constructor TTimerThread.Create(CreateSuspended: Boolean);
begin
inherited;
FreeOnTerminate := True;
FTickEvent := CreateEvent(nil, True, False, nil);
end;
destructor TTimerThread.Destroy;
begin
CloseHandle(FTickEvent);
inherited;
end;
procedure TTimerThread.Execute;
begin
CoInitialize(nil);
try
while not Terminated do
begin
if WaitForSingleObject(FTickEvent, 10000) = WAIT_TIMEOUT then
begin
EmailService.SendPDFFile;
end;
end;
finally
CoUnInitialize;
end;
end;
procedure TTimerThread.FinishThreadExecution;
begin
Terminate;
SetEvent(FTickEvent);
end;
end.