[델파이 - DELPHI] SFTP Server Service (Devart SecureBridge)

1. 서비스 폼

2. db는 firedac sqllite 사용

3. 환경설정 폼은 별도 개발 완료.

 

Delphi SSH, SFTP, FTPS, SSL, HTTP/HTTPS, WebSocket and SignalR Сlient and Server (devart.com)

 

unit uMain_Svr;

 

interface

 

uses

  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.SvcMgr, Vcl.Dialogs, System.Generics.Collections,

  ScBridge, ScSSHServer, ScSFTPServer, ScSFTPClient, uTPLb_CryptographicLibrary, uTPLb_BaseNonVisualComponent, uTPLb_Codec, Winsock, ScSFTPUtils,

  ScSFTPConsts, uSftpServer, ScUtils, ScSSHUtils, ScSSHSocket, FireDAC.Stan.ExprFuncs, FireDAC.Phys.SQLiteWrapper.Stat, FireDAC.Phys.SQLiteDef,

  FireDAC.Phys.SQLite, FireDAC.Stan.Intf, FireDAC.Stan.Option, FireDAC.Stan.Error, FireDAC.UI.Intf, FireDAC.Phys.Intf, FireDAC.Stan.Def,

  System.IniFiles, FireDAC.Stan.Pool, TypInfo, FireDAC.Stan.Async, FireDAC.Phys, FireDAC.FMXUI.Wait, FireDAC.Stan.Param, FireDAC.DatS,

  FireDAC.DApt.Intf, FireDAC.DApt, Data.DB, FireDAC.Comp.DataSet, FireDAC.Comp.Client, System.Variants, uLog, FireDAC.VCLUI.Wait, Winapi.ActiveX;

 

type

 

  TLogWriteThread = class(TThread) // 로그 쌓는 쓰레드

  private

    { private declarations }

    FDQuery : TFDQuery;

  protected

    { protected declarations }

  public

    constructor Create;

    destructor Destroy; override;

    procedure Execute; override;  // 큐 방식으로 DEQUEUE를 통해 .SQLLITE3 로컬 DB 적재

  published

    { published declarations }

  end;

 

  TSFTP_Server_Service = class(TService)

    ScSFTPServer1 : TScSFTPServer;  // SFTP 서버

    ScSSHServer1 : TScSSHServer;    // SSH 서버

    ScMemoryStorage1 : TScMemoryStorage; // KEY, USER를 담기위한 저장공간

    FDConnection1 : TFDConnection; // FIREDAC SQLLITE3 커넥션

    procedure ServiceCreate(Sender : TObject);

    procedure ServiceDestroy(Sender : TObject);

    procedure ServiceStart(Sender : TService; var Started : Boolean);  // 서비스 시작

    procedure ServiceStop(Sender : TService; var Stopped : Boolean);  // 서비스 종료

    procedure ScSSHServer1AfterClientConnect(Sender : TObject; ClientInfo : TScSSHClientInfo);  // 클라이언트 연결

    procedure ScSSHServer1AfterClientDisconnect(Sender : TObject; ClientInfo : TScSSHClientInfo); // 클라이언트 연결해제

    procedure ScSSHServer1ClientError(Sender : TObject; ClientInfo : TScSSHClientInfo; E : Exception); // 클라이언트 에러

    procedure ScSSHServer1Error(Sender : TObject; E : Exception); // 서버 에러

    procedure ScSFTPServer1MakeDirectory(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const Path : string; var Error : TScSFTPError); // SFTP서버 디렉토리 생성 프로시저

    procedure ScSFTPServer1RemoveDirectory(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const Path : string; var Error : TScSFTPError);  // SFTP서버 디렉토리 삭제 프로시저

    procedure ScSFTPServer1RemoveFile(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const FileName : string; var Error : TScSFTPError); // 파일 삭제 프로시저

    procedure ScSFTPServer1RenameFile(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const OldName, NewName : string; // 파일 이름 변경 프로시저

      const Flags : TScSFTPRenameFlags; var Error : TScSFTPError);

    procedure ScSFTPServer1OpenFile(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const FileName : string; // 파일 다운 및 업로드

      const OpenAttributes : TScSFTPFileOpenAttributes; out Data : TObject; var Error : TScSFTPError);

  private

    { Private declarations }

    FUserList : TList<TSftpUser>; // User 리스트

    FConnectPortList : TList<Integer>; // 연결된 포트 리스트

    // FDConnection1 : TFDConnection;

    procedure LoadInfo; // 정보 불러오기

    procedure SettingServer; // 서버 세팅

    function GetDecryptText(value : string) : string;

  public

    { Public declarations }

    LogQueue : TQueue<string>; // 로그를 담기위한 큐

    LogWriteThread : TLogWriteThread;

    function GetServiceController : TServiceController; override;

    procedure CreateLogDBTable; // 데이터 베이스 및 테이블 생성

  end;

 

var

  SFTP_Server_Service : TSFTP_Server_Service;

  csCriticalSection : TRTLCriticalSection;

  KillEvt : THandle;

 

const

  INSERT_SFTPLOG = 'INSERT INTO TBL_SFTPLOG VALUES(''%s'', ''%s'', ''%s'', ''%s'', %d, ''%s'', ''%s'', ''%s'', ''%s'');';

 

  INSERT_SESSTIONLOG =

    'INSERT INTO TBL_SESSIONLOG(CONNECTTIME, IP, PORT, SERVERUSER, CLIENTVERSION, ETC1, ETC2) VALUES(''%s'', ''%s'', %d, ''%s'', ''%s'', ''%s'', ''%s'');';

 

  UPDATE_SESSTIONLOG =

    'UPDATE TBL_SESSIONLOG SET DISCONNECTTIME = ''%s'' WHERE DISCONNECTTIME IS NULL AND IP = ''%s'' AND PORT = ''%d'' AND CLIENTVERSION = ''%s'';';

 

implementation

 

var

  gnPort : Integer;

 

{$R *.dfm}

 

function GetNowTime : string;

begin

  Result := FormatDateTime('yyyy-mm-dd hh:nn:ss', now);

end;

 

procedure ServiceController(CtrlCode : DWord); stdcall;

begin

  SFTP_Server_Service.Controller(CtrlCode);

end;

 

procedure TSFTP_Server_Service.CreateLogDBTable;

begin

  if FDConnection1.Connected then

  begin

    try

      FDConnection1.ExecSQL

        ('CREATE TABLE if NOT exists TBL_SESSIONLOG(IDX INTEGER PRIMARY KEY AUTOINCREMENT, CONNECTTIME TEXT NULL, DISCONNECTTIME TEXT NULL, IP TEXT NULL, PORT INTEGER NULL, SERVERUSER TEXT NULL, CLIENTVERSION TEXT NULL, ETC1 TEXT NULL, ETC2 TEXT NULL);');

      FDConnection1.ExecSQL

        ('CREATE TABLE IF NOT EXISTS TBL_SFTPLOG(INPUTDATE text NULL, LOGTYPE text NULL, SERVERUSER text NULL, IP text NULL, PORT int NULL, PATH text NULL, MESSAGE text NULL, ERRCODE text NULL, CLIENTVERSION text NULL);');

 

      FDConnection1.ExecSQL(Format(INSERT_SFTPLOG, [GetNowTime, 'START', 'ADMIN', '0.0.0.0', gnPort, NULL, NULL, NULL, NULL]));

    except

      on E : Exception do

        WriteLog('CreateLogDBTable Exception : ' + E.Message);

    end;

  end;

end;

 

function TSFTP_Server_Service.GetDecryptText(value : string) : string;

begin

  Result := string.Empty;

 

  // Codec1.DecryptString(Result, value, TEncoding.UTF8);

end;

 

function TSFTP_Server_Service.GetServiceController : TServiceController;

begin

  Result := ServiceController;

end;

 

procedure TSFTP_Server_Service.LoadInfo;

var

  sid, spw, sdir : string;

  FDQuery : TFDQuery;

begin

  FDQuery := TFDQuery.Create(nil);

  try

    try

      FDQuery.Connection := FDConnection1;

      FDQuery.SQL.Add('SELECT * FROM TBL_SYSTEM WHERE TYPE = ''PORT'';');

      FDQuery.Open;

 

      if not FDQuery.IsEmpty then

        gnPort := FDQuery.FieldByName('PORT').AsInteger

      else

        gnPort := 22;

 

      FDQuery.Close;

      FDQuery.SQL.Clear;

      FDQuery.SQL.Add('SELECT * FROM TBL_SYSTEM WHERE TYPE = ''USER'';');

      FDQuery.Open;

 

      if not FDQuery.IsEmpty then

      begin

        while not FDQuery.Eof do

        begin

          sid  := FDQuery.FieldByName('User').AsString;

          spw  := FDQuery.FieldByName('PASSWORD').AsString;

          sdir := FDQuery.FieldByName('DIR').AsString;

          // WriteLog(sid + spw + sdir);

          FUserList.Add(TSftpUser.Create(sid, spw, sdir));

 

          FDQuery.Next;

        end;

      end;

    except

      on E : Exception do

        WriteLog('LoadInfo Exception : ' + E.Message);

    end;

  finally

    FDQuery.Close;

    FDQuery.DisposeOf;

  end;

end;

 

procedure TSFTP_Server_Service.ScSFTPServer1MakeDirectory(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const Path : string;

  var Error : TScSFTPError);

begin

  EnterCriticalSection(csCriticalSection); // 동시다발적으로 큐에 접근시 access error가 발생할 수 있어 크리티컬 세션 진입

  try

    try

      ScSFTPServer1.DefaultMakeDirectory(SFTPSessionInfo, Path, Error); // 따로 이벤트를 정의시 defualt 프로시저를 호출해야함.

 

      LogQueue.Enqueue(Format(INSERT_SFTPLOG, [GetNowTime, 'MakeDirectory', SFTPSessionInfo.Client.User,

        inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port), 'Path: ' + Path, Error.ErrorMessage,

        GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode)), SFTPSessionInfo.Client.Version])); // queue에 로그 담기

 

      WriteLog(Format('MakeDirectory - User: %s, IP: %s, PORT: %d, Version: %s, Path: %s, Error: %s, ErrorCode : %s',

        [SFTPSessionInfo.Client.User, inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port),

        SFTPSessionInfo.Client.Version, Path, Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode))]));

    except

      on E1 : Exception do

        WriteLog('MakeDirectory Exception : ' + E1.Message);

    end;

  finally

    LeaveCriticalSection(csCriticalSection); // 크리티컬 세션 떠나기

  end;

end;

 

procedure TSFTP_Server_Service.ScSFTPServer1OpenFile(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const FileName : string;

  const OpenAttributes : TScSFTPFileOpenAttributes; out Data : TObject; var Error : TScSFTPError);

begin

  EnterCriticalSection(csCriticalSection); // 동시다발적으로 큐에 접근시 access error가 발생할 수 있어 크리티컬 세션 진입

  try

    try

      ScSFTPServer1.DefaultOpenFile(SFTPSessionInfo, FileName, OpenAttributes, Data, Error); // 따로 이벤트를 정의시 defualt 프로시저를 호출해야함.

 

      if OpenAttributes.Mode = fmCreateOrTruncate then // 업로드

      begin

        LogQueue.Enqueue(Format(INSERT_SFTPLOG, [GetNowTime, 'Upload', SFTPSessionInfo.Client.User,

          inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port), 'FileName: ' + FileName,

          Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode)), SFTPSessionInfo.Client.Version]));

 

        WriteLog(Format('Upload - User: %s, IP: %s, PORT: %d, Version: %s, FileName: %s, Error: %s, ErrorCode : %s',

          [SFTPSessionInfo.Client.User, inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port),

          SFTPSessionInfo.Client.Version, FileName, Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode))]));

      end

      else if OpenAttributes.Mode = fmOpenExisting then // 다운로드

      begin

        LogQueue.Enqueue(Format(INSERT_SFTPLOG, [GetNowTime, 'Download', SFTPSessionInfo.Client.User,

          inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port), 'FileName: ' + FileName,

          Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode)), SFTPSessionInfo.Client.Version]));

 

        WriteLog(Format('Download - User: %s, IP: %s, PORT: %d, Version: %s, FileName: %s, Error: %s, ErrorCode : %s',

          [SFTPSessionInfo.Client.User, inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port),

          SFTPSessionInfo.Client.Version, FileName, Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode))]));

      end;

    except

      on E1 : Exception do

        WriteLog('OpenFile Exception : ' + E1.Message);

    end;

  finally

    LeaveCriticalSection(csCriticalSection); // 크리티컬 세션 떠나기

  end

end;

 

procedure TSFTP_Server_Service.ScSFTPServer1RemoveDirectory(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const Path : string;

  var Error : TScSFTPError);

begin

  EnterCriticalSection(csCriticalSection);

  try

    try

      ScSFTPServer1.DefaultRemoveDirectory(SFTPSessionInfo, Path, Error);   // 따로 이벤트를 정의시 defualt 프로시저를 호출해야함.

 

      LogQueue.Enqueue(Format(INSERT_SFTPLOG, [GetNowTime, 'RemoveDirectory', SFTPSessionInfo.Client.User,

        inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port), 'Path: ' + Path, Error.ErrorMessage,

        GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode)), SFTPSessionInfo.Client.Version]));

 

      WriteLog(Format('RemoveDirectory - User: %s, IP: %s, PORT: %d, Version: %s, Path: %s, Error: %s, ErrorCode : %s',

        [SFTPSessionInfo.Client.User, inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port),

        SFTPSessionInfo.Client.Version, Path, Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode))]));

    except

      on E1 : Exception do

        WriteLog('RemoveDirectory Exception : ' + E1.Message);

    end;

  finally

    LeaveCriticalSection(csCriticalSection);

  end;

end;

 

procedure TSFTP_Server_Service.ScSFTPServer1RemoveFile(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const FileName : string;

  var Error : TScSFTPError); // 파일 삭제

begin

  EnterCriticalSection(csCriticalSection);

  try

    try

      ScSFTPServer1.DefaultRemoveFile(SFTPSessionInfo, FileName, Error); // 따로 이벤트를 정의시 defualt 프로시저를 호출해야함.

 

      LogQueue.Enqueue(Format(INSERT_SFTPLOG, [GetNowTime, 'RemoveFile', SFTPSessionInfo.Client.User,

        inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port), 'FileName: ' + FileName,

        Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode)), SFTPSessionInfo.Client.Version]));

 

      WriteLog(Format('RemoveFile - User: %s, IP: %s, PORT: %d, Version: %s, FileName: %s, Error: %s, ErrorCode : %s',

        [SFTPSessionInfo.Client.User, inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port),

        SFTPSessionInfo.Client.Version, FileName, Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode))]));

    except

      on E1 : Exception do

        WriteLog('RemoveFile Exception : ' + E1.Message);

    end;

  finally

    LeaveCriticalSection(csCriticalSection);

  end;

end;

 

procedure TSFTP_Server_Service.ScSFTPServer1RenameFile(Sender : TObject; SFTPSessionInfo : TScSFTPSessionInfo; const OldName, NewName : string;

  const Flags : TScSFTPRenameFlags; var Error : TScSFTPError); // 파일 이름 변경

begin

  EnterCriticalSection(csCriticalSection);

  try

    try

      ScSFTPServer1.DefaultRenameFile(SFTPSessionInfo, OldName, NewName, Flags, Error); // 따로 이벤트를 정의시 defualt 프로시저를 호출해야함.

 

      LogQueue.Enqueue(Format(INSERT_SFTPLOG, [GetNowTime, 'RenameFile', SFTPSessionInfo.Client.User,

        inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port),

        'OldName: ' + OldName + ', NewName: ' + NewName, Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode), Integer(Error.ErrorCode)),

        SFTPSessionInfo.Client.Version]));

 

      WriteLog(Format('RenameFile - User: %s, IP: %s, PORT: %d, Version: %s, file: %s, Error: %s, ErrorCode : %s',

        [SFTPSessionInfo.Client.User, inet_ntoa(SFTPSessionInfo.Client.SockAddr.sin_addr), htons(SFTPSessionInfo.Client.SockAddr.sin_port),

        SFTPSessionInfo.Client.Version, 'OldName: ' + OldName + ', NewName: ' + NewName, Error.ErrorMessage, GetEnumName(TypeInfo(TScSFTPErrorCode),

        Integer(Error.ErrorCode))]));

    except

      on E1 : Exception do

        WriteLog('RenameFile Exception : ' + E1.Message);

    end;

  finally

    LeaveCriticalSection(csCriticalSection);

  end;

end;

 

procedure TSFTP_Server_Service.ScSSHServer1AfterClientConnect(Sender : TObject; ClientInfo : TScSSHClientInfo); // 클라이언트가 연결된 후

begin

  if FConnectPortList.IndexOf(htons(ClientInfo.SockAddr.sin_port)) = -1 then // 연결된 리스트에 있나 검색

  begin

    EnterCriticalSection(csCriticalSection);

    try

      try

        FConnectPortList.Add(htons(ClientInfo.SockAddr.sin_port)); // 없으면 추가

 

        LogQueue.Enqueue(Format(INSERT_SESSTIONLOG, [GetNowTime, inet_ntoa(ClientInfo.SockAddr.sin_addr), htons(ClientInfo.SockAddr.sin_port),

          ClientInfo.User, ClientInfo.Version, NULL, NULL]));

        LogQueue.Enqueue(Format(INSERT_SFTPLOG, [GetNowTime, 'CONNECT', ClientInfo.User, inet_ntoa(ClientInfo.SockAddr.sin_addr),

          htons(ClientInfo.SockAddr.sin_port), NULL, NULL, NULL, ClientInfo.Version]));

 

        WriteLog(Format('ClientConnect - User: %s, IP: %s, PORT: %d, Version: %s', [ClientInfo.User, inet_ntoa(ClientInfo.SockAddr.sin_addr),

          htons(ClientInfo.SockAddr.sin_port), ClientInfo.Version]));

      except

        on E : Exception do

          WriteLog('ClientConnect Exception : ' + E.Message);

      end;

    finally

      LeaveCriticalSection(csCriticalSection);

    end;

  end;

end;

 

procedure TSFTP_Server_Service.ScSSHServer1AfterClientDisconnect(Sender : TObject; ClientInfo : TScSSHClientInfo); // 클라이언트와 연결 해제

begin

  EnterCriticalSection(csCriticalSection);

  try

    try

      if FConnectPortList.IndexOf(htons(ClientInfo.SockAddr.sin_port)) <> -1 then // 리스트에 있나 검색

      begin

        FConnectPortList.Delete(FConnectPortList.IndexOf(htons(ClientInfo.SockAddr.sin_port))); // 있으면 delete 후 연결해제 로그 쌓기

 

        LogQueue.Enqueue(Format(UPDATE_SESSTIONLOG, [GetNowTime, inet_ntoa(ClientInfo.SockAddr.sin_addr), htons(ClientInfo.SockAddr.sin_port),

          ClientInfo.Version]));

        LogQueue.Enqueue(Format(INSERT_SFTPLOG, [GetNowTime, 'DISCONNECT', ClientInfo.User, inet_ntoa(ClientInfo.SockAddr.sin_addr),

          htons(ClientInfo.SockAddr.sin_port), NULL, NULL, NULL, ClientInfo.Version]));

 

        WriteLog(Format('ClientDisconnect - User: %s, IP: %s, PORT: %d, Version: %s', [ClientInfo.User, inet_ntoa(ClientInfo.SockAddr.sin_addr),

          htons(ClientInfo.SockAddr.sin_port), ClientInfo.Version]));

      end;

    except

      on E : Exception do

        WriteLog('ClientDisconnect Exception : ' + E.Message);

    end;

  finally

    LeaveCriticalSection(csCriticalSection);

  end;

end;

 

procedure TSFTP_Server_Service.ScSSHServer1ClientError(Sender : TObject; ClientInfo : TScSSHClientInfo; E : Exception);

begin

  EnterCriticalSection(csCriticalSection);

  try

    try

      LogQueue.Enqueue(Format(INSERT_SFTPLOG, [GetNowTime, 'Error', ClientInfo.User, inet_ntoa(ClientInfo.SockAddr.sin_addr),

        htons(ClientInfo.SockAddr.sin_port), NULL, NULL, NULL, ClientInfo.Version]));

 

      WriteLog(Format('ClientError - User: %s, IP: %s, PORT: %d, Version: %s, Error: %s', [ClientInfo.User, inet_ntoa(ClientInfo.SockAddr.sin_addr),

        htons(ClientInfo.SockAddr.sin_port), ClientInfo.Version, E.Message]));

    except

      on E1 : Exception do

        WriteLog('ClientError Exception : ' + E.Message);

    end;

  finally

    LeaveCriticalSection(csCriticalSection);

  end;

end;

 

procedure TSFTP_Server_Service.ScSSHServer1Error(Sender : TObject; E : Exception);

begin

  WriteLog(E.Message);

end;

 

procedure TSFTP_Server_Service.ServiceCreate(Sender : TObject);

begin

  WriteLog('ServiceCreate');

end;

 

procedure TSFTP_Server_Service.ServiceDestroy(Sender : TObject);

begin

  WriteLog('ServiceDestroy');

end;

 

procedure TSFTP_Server_Service.ServiceStart(Sender : TService; var Started : Boolean);

begin

  WriteLog('ServiceStart');

  // Codec1.Password := 'HanilnR&D';

 

  FUserList        := TList<TSftpUser>.Create;

  FConnectPortList := TList<Integer>.Create;

  LogQueue         := TQueue<string>.Create;

 

  if not DirectoryExists(ExtractFilepath(paramstr(0)) + 'DB') then

    ForceDirectories(ExtractFilepath(paramstr(0)) + 'DB');

 

  FDConnection1.Params.DriverID := 'SQLite';  // sqlite3

  FDConnection1.Params.Database := ExtractFilepath(paramstr(0)) + 'DB' + '\' + 'SFTPLog' + '.sdb';

  FDConnection1.Connected       := True;

 

  LoadInfo;

  SettingServer;

  CreateLogDBTable;

  ScSSHServer1.Active := True;

  Started             := True;

 

  LogWriteThread := TLogWriteThread.Create;

  LogWriteThread.Start;

end;

 

procedure TSFTP_Server_Service.ServiceStop(Sender : TService; var Stopped : Boolean);

begin

  WriteLog('ServiceStop');

  SetEvent(KillEvt);

 

  FConnectPortList.Clear;

  FConnectPortList.DisposeOf;

  FUserList.Clear;

  FUserList.DisposeOf;

  LogQueue.Clear;

  LogQueue.DisposeOf;

 

  FDConnection1.Close;

 

  ScSSHServer1.Active := False;

  Stopped             := True;

end;

 

procedure TSFTP_Server_Service.SettingServer;

var

  Key1 : TScKey;

begin

  ScSSHServer1.Port       := gnPort;

  ScSSHServer1.KeyNameRSA := 'SBSSHServer_RSA'; // RSA 방식

 

  with TiniFile.Create(ExtractFilepath(paramstr(0)) + 'Setup.ini') do // 취약한 알고리즘인 cbc 방식은 기본 false

  begin

    if ReadBool('Ciphers', '3DES_CBC', False) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saTripleDES_cbc]

    else if ReadBool('Ciphers', 'Blowfish_CBC', False) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saBlowfish_cbc]

    else if ReadBool('Ciphers', 'AES128_CBC', False) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saAES128_cbc]

    else if ReadBool('Ciphers', 'AES192_CBC', False) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saAES192_cbc]

    else if ReadBool('Ciphers', 'AES256_CBC', False) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saAES256_cbc]

    else if ReadBool('Ciphers', '3DES_CTR', True) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saTripleDES_ctr]

    else if ReadBool('Ciphers', 'Blowfish_CTR', True) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saBlowfish_ctr]

    else if ReadBool('Ciphers', 'AES128_CTR', True) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saAES128_ctr]

    else if ReadBool('Ciphers', 'AES192_CTR', True) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saAES192_ctr]

    else if ReadBool('Ciphers', 'AES256_CTR', True) then

      ScSSHServer1.Ciphers := ScSSHServer1.Ciphers + [saAES256_ctr];

 

    Free;

  end;

 

  ScMemoryStorage1.Keys.Clear;

  ScMemoryStorage1.Users.Clear;

  if FUserList.Count > 0 then

  begin

    for var i : Integer := 0 to FUserList.Count - 1 do

    begin

      var

        User : TScUser;

 

      User                       := TScUser.Create(ScMemoryStorage1.Users);

      User.UserName              := FUserList.Items[i].User;

      User.Password              := FUserList.Items[i].Password;

      User.HomePath              := FUserList.Items[i].HomeDir;

      User.Authentications       := [uaPassword];

      User.SSHChannelPermissions := [cpAllowShell, cpAllowSFTP];

    end;

  end;

 

  Key1 := TScKey.Create(nil);

 

  try

// 1. 먼저 key genertate 한 후 exportTo를 해야 다음 서비스 실행시 키가 변경이 안 됨.

    // Key1.Generate(aaRSA, 2048);

    Key1.KeyName := 'SBSSHServer_RSA';

    // Key1.ExportTo(ExtractFilepath(paramstr(0)) + 'SFTPServer_RSA.ssl', false, 'test');

 

// 2. 서비스 재시작시 export한 ssl를 import해야 호스트 키가 변경이 안됨.

    Key1.ImportFrom(ExtractFilepath(paramstr(0)) + 'SFTPServer_RSA.ssl', 'test');

 

    ScMemoryStorage1.Keys.Add(Key1);

  except

    Key1.Free;

    raise;

  end;

  ScMemoryStorage1.Keys.Refresh;

end;

 

{ TLogWriteThread }

 

constructor TLogWriteThread.Create;

begin

  inherited Create(True); // 쓰레드 시작을 별도 start로 시작하기 위해 Create(True)

 

  FDQuery := TFDQuery.Create(nil);

end;

 

destructor TLogWriteThread.Destroy;

begin

  FDQuery.Close;

  FDQuery.DisposeOf;

  inherited;

end;

 

procedure TLogWriteThread.Execute;

begin

  CoInitialize(nil);

  FreeOnTerminate := True;

 

  while not Terminated do

  begin

    try

      with SFTP_Server_Service do

      begin

        if LogQueue.Count > 0 then

        begin

          try

            FDQuery.Connection := FDConnection1;

 

            EnterCriticalSection(csCriticalSection);

            try

              while LogQueue.Count > 0 do

              begin

                FDQuery.SQL.Add(LogQueue.Dequeue);

              end;

            finally

              LeaveCriticalSection(csCriticalSection);

            end;

            FDQuery.OpenOrExecute;

            WriteLog('FDQuery.OpenOrExecute - ' + FDQuery.SQL.Text, 'SQL');

          finally

            FDQuery.SQL.Clear;

            FDQuery.Close;

          end;

        end;

      end;

 

    except

      on E : Exception do

        WriteLog('LogWriteThread Execute Exception - ' + E.Message);

    end;

    if WaitForSingleObject(KillEvt, 1000 * 3) = WAIT_OBJECT_0 then // 3초마다 실행

      exit;

  end;

  CoUninitialize;

end;

 

initialization

 

InitializeCriticalSection(csCriticalSection);

KillEvt := CreateEvent(nil, True, False, PChar('KillThread'));

 

Finalization

 

DeleteCriticalSection(csCriticalSection);

CloseHandle(KillEvt);

 

end.