ib_services.pas

FIBPlus is a component suite intended for work with InterBase. It is direct, fast and flexible Inter

    Inc(done);
    Inc(RunLen);
    case Integer(OutputBuffer[RunLen-1]) of
      isc_info_svc_version:
        FVersionInfo.ServiceVersion := ParseInteger(RunLen);
      isc_info_svc_server_version:
        FVersionInfo.ServerVersion := ParseString(RunLen);
      isc_info_svc_implementation:
        FVersionInfo.ServerImplementation := ParseString(RunLen);
      else
        FIBError(feOutputParsingError, [nil]);
    end;
  end;
end;

{ TpFIBControlService }
procedure TpFIBControlService.SetServiceStartOptions;
begin

end;

function TpFIBControlService.GetIsServiceRunning: Boolean;
var
  RunLen: Integer;
begin
  ServiceQueryParams := Char(isc_info_svc_running);
  InternalServiceQuery;
  if (OutputBuffer[0] <> Char(isc_info_svc_running)) then
    FIBError(feOutputParsingError, [nil]);
  RunLen := 1;
  if (ParseInteger(RunLen) = 1) then
    result := True
  else
    result := False;
end;

procedure TpFIBControlService.ServiceStartAddParam (Value: string; param: Integer);
var
  Len: UShort;
begin
  Len := Length(Value);
  if Len > 0 then
  begin
    FStartParams  := FStartParams +
                     Char(Param) +
                     PChar(@Len)[0] +
                     PChar(@Len)[1] +
                     Value;
  end;
end;

procedure TpFIBControlService.ServiceStartAddParam (Value: Integer; param: Integer);
begin
  FStartParams  := FStartParams +
                   Char(Param) +
                   PChar(@Value)[0] +
                   PChar(@Value)[1] +
                   PChar(@Value)[2] +
                   PChar(@Value)[3];
end;

constructor TpFIBControlService.Create(AOwner: TComponent);
begin
  inherited create(AOwner);
  FStartParams := '';
  FStartSPB := nil;
  FStartSPBLength := 0;
end;

procedure TpFIBControlService.InternalServiceStart;
begin
  FStartSPBLength := Length(FStartParams);
  if FStartSPBLength = 0 then
    FIBError(feStartParamsError, [nil]);
  FIBAlloc(FStartSPB, 0, FStartSPBLength);
  Move(FStartParams[1], FStartSPB[0], FstartSPBLength);
  try
    LoadLibrary;
    if call(FClientLibrary.isc_service_start(StatusVector, @FHandle, nil,
                           FStartSPBLength, FStartSPB), False) > 0 then
    begin
      FHandle := nil;
      IBError(FClientLibrary, Self);
    end;
  finally
    FreeMem(FStartSPB);
    FStartSPB := nil;
    FStartSPBLength := 0;
    FStartParams := '';
  end;
{$IFNDEF NO_MONITOR}
  MonitorHook.ServiceStart(Self);
{$ENDIF}
end;

procedure TpFIBControlService.ServiceStart;
begin
  CheckActive;
  SetServiceStartOptions;
  InternalServiceStart;
end;

{ TpFIBConfigService }

procedure TpFIBConfigService.ServiceStart;
begin
  FIBError(feUseSpecificProcedures, [nil]);
end;

procedure TpFIBConfigService.ActivateShadow;
begin
  ServiceStartParams  := Char(isc_action_svc_properties);
  ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartAddParam (isc_spb_prp_activate, SPBConstantValues[isc_spb_options]);
  InternalServiceStart;
end;

procedure TpFIBConfigService.BringDatabaseOnline;
begin
  ServiceStartParams  := Char(isc_action_svc_properties);
  ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartAddParam (isc_spb_prp_db_online, SPBConstantValues[isc_spb_options]);
  InternalServiceStart;
end;

procedure TpFIBConfigService.SetAsyncMode(Value: Boolean);
begin
  ServiceStartParams  := Char(isc_action_svc_properties);
  ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartParams := ServiceStartParams +
                        Char(isc_spb_prp_write_mode);
  if Value then
    ServiceStartParams  := ServiceStartParams +
                           Char(isc_spb_prp_wm_async)
  else
    ServiceStartParams  := ServiceStartParams +
                           Char(isc_spb_prp_wm_sync);
  InternalServiceStart;
end;

procedure TpFIBConfigService.SetDatabaseName(const Value: string);
begin
  FDatabaseName := Value;
end;

procedure TpFIBConfigService.SetPageBuffers(Value: Integer);
begin
  ServiceStartParams  := Char(isc_action_svc_properties);
  ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartAddParam (Value, isc_spb_prp_page_buffers);
  InternalServiceStart;
end;

procedure TpFIBConfigService.SetReadOnly(Value: Boolean);
begin
  ServiceStartParams  := Char(isc_action_svc_properties);
  ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartParams := ServiceStartParams +
                         Char(isc_spb_prp_access_mode);
  if Value then
    ServiceStartParams  := ServiceStartParams +
                           Char(isc_spb_prp_am_readonly)
  else
    ServiceStartParams  := ServiceStartParams +
                           Char(isc_spb_prp_am_readwrite);
  InternalServiceStart;
end;

procedure TpFIBConfigService.SetReserveSpace(Value: Boolean);
begin
  ServiceStartParams  := Char(isc_action_svc_properties);
  ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartParams := ServiceStartParams +
                        Char(isc_spb_prp_reserve_space);
  if Value then
    ServiceStartParams  := ServiceStartParams +
                           Char(isc_spb_prp_res)
  else
    ServiceStartParams  := ServiceStartParams +
                           Char(isc_spb_prp_res_use_full);
  InternalServiceStart;
end;

procedure TpFIBConfigService.SetSweepInterval(Value: Integer);
begin
  ServiceStartParams  := Char(isc_action_svc_properties);
  ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartAddParam (Value, isc_spb_prp_sweep_interval);
  InternalServiceStart;
end;

procedure TpFIBConfigService.SetDBSqlDialect(Value: Integer);
begin
  ServiceStartParams  := Char(isc_action_svc_properties);
  ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartAddParam (Value, isc_spb_prp_set_sql_dialect);
  InternalServiceStart;
end;

procedure TpFIBConfigService.ShutdownDatabase(Options: TShutdownMode;
  Wait: Integer);
begin
  ServiceStartParams  := Char(isc_action_svc_properties);
  ServiceStartAddParam (FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  if (Options = Forced) then
    ServiceStartAddParam (Wait, isc_spb_prp_shutdown_db)
  else if (Options = DenyTransaction) then
    ServiceStartAddParam (Wait, isc_spb_prp_deny_new_transactions)
  else
    ServiceStartAddParam (Wait, isc_spb_prp_deny_new_attachments);
  InternalServiceStart;
end;

{ TpFIBLicensingService }
procedure TpFIBLicensingService.SetAction(Value: TLicensingAction);
begin
  FAction := Value;
  if (Value = LicenseRemove) then
   FID := '';
end;

procedure TpFIBLicensingService.AddLicense;
begin
  Action := LicenseAdd;
  Servicestart;
end;

procedure TpFIBLicensingService.RemoveLicense;
begin
  Action := LicenseRemove;
  Servicestart;
end;

procedure TpFIBLicensingService.SetServiceStartOptions;
begin
  if (FAction = LicenseAdd) then begin
    ServiceStartParams  := Char(isc_action_svc_add_license);
    ServiceStartAddParam (FKey, isc_spb_lic_key);
    ServiceStartAddParam (FID, isc_spb_lic_id);
  end
  else begin
    ServiceStartParams  := Char(isc_action_svc_remove_license);
    ServiceStartAddParam (FKey, isc_spb_lic_key);
  end;
end;

{ TpFIBStatisticalService }

procedure TpFIBStatisticalService.SetDatabaseName(const Value: string);
begin
  FDatabaseName := Value;
end;

procedure TpFIBStatisticalService.SetServiceStartOptions;
var
  param: Integer;
begin
  if FDatabaseName = '' then
    FIBError(feStartParamsError, [nil]);
  param := 0;
  if (DataPages in Options) then
    param := param or isc_spb_sts_data_pages;
  if (DbLog in Options) then
    param := param or isc_spb_sts_db_log;
  if (HeaderPages in Options) then
    param := param or isc_spb_sts_hdr_pages;
  if (IndexPages in Options) then
    param := param or isc_spb_sts_idx_pages;
  if (SystemRelations in Options) then
    param := param or isc_spb_sts_sys_relations;
  if (RecordVersions in Options) then
    param := param or isc_spb_sts_record_versions;
  if (StatTables in Options) then
    param := param or isc_spb_sts_table;

  Action := isc_action_svc_db_stats;
  ServiceStartParams  := Char(isc_action_svc_db_stats);
  ServiceStartAddParam(FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartAddParam(param, SPBConstantValues[isc_spb_options]);
  if (StatTables in Options) then
    ServiceStartAddParam(FTableNames, SPBConstantValues[isc_spb_command_line]);
end;

{ TpFIBBackupService }
procedure TpFIBBackupService.SetServiceStartOptions;
var
  param, i: Integer;
  value: String;
begin
  if FDatabaseName = '' then
    FIBError(feStartParamsError, [nil]);
  param := 0;
  if (IgnoreChecksums in Options) then
    param := param or isc_spb_bkp_ignore_checksums;
  if (IgnoreLimbo in Options) then
    param := param or isc_spb_bkp_ignore_limbo;
  if (MetadataOnly in Options) then
    param := param or isc_spb_bkp_metadata_only;
  if (NoGarbageCollection in Options) then
    param := param or isc_spb_bkp_no_garbage_collect;
  if (OldMetadataDesc in Options) then
    param := param or isc_spb_bkp_old_descriptions;
  if (NonTransportable in Options) then
    param := param or isc_spb_bkp_non_transportable;
  if (ConvertExtTables in Options) then
    param := param or isc_spb_bkp_convert;
  Action := isc_action_svc_backup;
  ServiceStartParams  := Char(isc_action_svc_backup);
  ServiceStartAddParam(FDatabaseName, SPBConstantValues[isc_spb_dbname]);
  ServiceStartAddParam(param, SPBConstantValues[isc_spb_options]);
  if Verbose then
    ServiceStartParams := ServiceStartParams + Char(SPBConstantValues[isc_spb_verbose]);
  if FBlockingFactor > 0 then
    ServiceStartAddParam(FBlockingFactor, isc_spb_bkp_factor);
  for i := 0 to FBackupFile.Count - 1 do
  begin
    if (Trim(FBackupFile[i]) = '') then
      continue;
    if (Pos('=', FBackupFile[i]) <> 0) then
    begin {mbcs ok}
      ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
      value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
      param := StrToInt(value);
      ServiceStartAddParam(param, isc_spb_bkp_length);
    end
    else
      ServiceStartAddParam(FBackupFile[i], isc_spb_bkp_file);
  end;
end;

constructor TpFIBBackupService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FBackupFile := TStringList.Create;
end;

destructor TpFIBBackupService.Destroy;
begin
  FBackupFile.Free;
  inherited Destroy;
end;

procedure TpFIBBackupService.SetBackupFile(const Value: TStrings);
begin
  FBackupFile.Assign(Value);
end;

{ TpFIBRestoreService }

procedure TpFIBRestoreService.SetServiceStartOptions;
var
  param, i: Integer;
  value: String;
begin
  param := 0;
  if (DeactivateIndexes in Options) then
    param := param or isc_spb_res_deactivate_idx;
  if (NoShadow in Options) then
    param := param or isc_spb_res_no_shadow;
  if (NoValidityCheck in Options) then
    param := param or isc_spb_res_no_validity;
  if (OneRelationAtATime in Options) then
    param := param or isc_spb_res_one_at_a_time;
  if (Replace in Options) then
    param := param or isc_spb_res_replace;
  if (CreateNewDB in Options) then
    param := param or isc_spb_res_create;
  if (UseAllSpace in Options) then
    param := param or isc_spb_res_use_all_space;
  if (ValidationCheck in Options) then
    param := param or isc_spb_res_validate;
  if (OnlyMetadata in Options) then
    param := param or isc_spb_bkp_metadata_only;

  Action := isc_action_svc_restore;
  ServiceStartParams  := Char(isc_action_svc_restore);
  ServiceStartAddParam(param, SPBConstantValues[isc_spb_options]);
  if Verbose then ServiceStartParams := ServiceStartParams + Char(SPBConstantValues[isc_spb_verbose]);
  if FPageSize > 0 then
    ServiceStartAddParam(FPageSize, isc_spb_res_page_size);
  if FPageBuffers > 0 then
    ServiceStartAddParam(FPageBuffers, isc_spb_res_buffers);
  for i := 0 to FBackupFile.Count - 1 do
  begin
    if (Trim(FBackupFile[i]) = '') then continue;
    if (Pos('=', FBackupFile[i]) <> 0) then  {mbcs ok}
    begin 
      ServiceStartAddParam(FBackupFile.Names[i], isc_spb_bkp_file);
      value := Copy(FBackupFile[i], Pos('=', FBackupFile[i]) + 1, Length(FBackupFile.Names[i])); {mbcs ok}
      param := StrToInt(value);
      ServiceStartAddParam(param, isc_spb_bkp_length);
    end
    else
      ServiceStartAddParam(FBackupFile[i], isc_spb_bkp_file);
  end;
  for i := 0 to FDatabaseName.Count - 1 do
  begin
    if (Trim(FDatabaseName[i]) = '') then continue;
    if (Pos('=', FDatabaseName[i]) <> 0) then {mbcs ok}
    begin 
      ServiceStartAddParam(FDatabaseName.Names[i], SPBConstantValues[isc_spb_dbname]);
      value := Copy(FDatabaseName[i], Pos('=', FDatabaseName[i]) + 1, Length(FDatabaseName[i])); {mbcs ok}
      param := StrToInt(value);
      ServiceStartAddParam(param, isc_spb_res_length);
    end
    else
      ServiceStartAddParam(FDatabaseName[i], SPBConstantValues[isc_spb_dbname]);
  end;
end;

constructor TpFIBRestoreService.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FDatabaseName := TStringList.Create;
  FBackupFile := TStringList.Create;
  Include (FOptions, CreateNewDB);
  FPageSize := 4096;
end;

destructor TpFIBRestoreService.Destroy;