Уважаемые делфийцы, помогите плиз чайнику.
Пытаюсь сделать архивирование интербейсовской базы (w.gdb) по нажатию некой кнопки:
var si: Tstartupinfo;
p: Tprocessinformation;
...
FillChar( Si, SizeOf( Si ) , 0 );
with Si do
begin
cb := SizeOf( Si);
dwFlags := startf_UseShowWindow;
wShowWindow := 4;
end;
CreateProcess(nil, 'gbak -b -g -user SYSDBA -password masterkey c:\temp\w.gdb c:\temp\w1.gbk', nil, nil,
false, Create_default_error_mode, nil, nil, si, p);
Waitforsingleobject(p.hProcess, infinite);
Ошибок никаких не выдает но и w1.gbk создавать и не пытается :/ Подскажите плиз что я с параметрами или с самим createprocess не так сделал?
Уважаемые авторы вопросов! Большая просьба сообщить о результатах решения проблемы на этой странице. Иначе, следящие за обсуждением, возможно имеющие аналогичные проблемы, не получают ясного представления об их решении. А авторы ответов не получают обратной связи. Что можно расценивать, как проявление неуважения к отвечающим от автора вопроса.
25-01-2005 11:51
program BuckUpGDB;
uses
SvcMgr,
Unit1 in 'Unit1.pas' {BackUpService: TService};
{$R *.RES}
begin
Application.Initialize;
Application.CreateForm(TBackUpService, BackUpService);
Application.Run;
end.
const
BackUplog='BuckUp.log';
type
TBackUpService = class(TService)
Timer1: TTimer;
IBBackupService1: TIBBackupService;
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceExecute(Sender: TService);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
Processing:Boolean;
backupStart:boolean;
BuckUpTime:TTime;
LogFile:String;
procedure CheckBuckup;
procedure BuckUp(ServerName:String;DataBaseName:String;BackUpFileName:String);
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
BackUpService: TBackUpService;
implementation
{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
BackUpService.Controller(CtrlCode);
end;
function TBackUpService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TBackUpService.ServiceStart(Sender: TService;
var Started: Boolean);
var
R:TRegistry;
s:String;
begin
Processing:=TRUE;
backupStart:=FALSE;
try
R:=TRegistry.Create;
try
R.RootKey:=HKEY_LOCAL_MACHINE;
if R.OpenKey('SOFTWARE\PaulsYard\BackUpDB',False) then
begin
s:=R.ReadString('TimeStart');
BuckUpTime:=StrToTime(s);
try
LogFile:=R.ReadString('LogFile');
except
LogFile:=BackUplog;
end;
end else Raise Exception.Create('Regkey not found:'+'"HKEY_LOCAL_MACHINE\SOFTWARE\PaulsYard\BackUpDB"');
finally
R.Free;
end;
except
on e:Exception do
begin
Started:=FALSE;
LogMessage(e.Message);
end;
end;
LogMessage('Started.',EVENTLOG_INFORMATION_TYPE);
end;
procedure TBackUpService.ServiceExecute(Sender: TService);
begin
while Processing do ServiceThread.ProcessRequests(True);
end;
procedure TBackUpService.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
Processing:=FALSE;
LogMessage('Stoped.',EVENTLOG_INFORMATION_TYPE);
end;
procedure TBackUpService.Timer1Timer(Sender: TObject);
begin
if (now>(BuckUpTime+Date))and(now<(BuckUpTime+Date+1/24/60/10)) then CheckBuckup;
end;
procedure TBackUpService.CheckBuckup;
var
R:TRegistry;
S1,S2:TStringList;
I,j,c:Integer;
ServerName:String;
BackUpFile:String;
BackUpDataBase:String;
begin
try
if backupStart then exit;
backupStart:=TRUE;
if R.OpenKey('SOFTWARE\PaulsYard\BackUpDB',False) then
begin
S1:=TStringList.Create;
try
R.GetKeyNames(S1);
R.CloseKey;
for i:=0 to S1.Count-1 do
begin
if not R.OpenKey('SOFTWARE\PaulsYard\BackUpDB\'+S1[i],FALSE) then
Raise Exception.Create('Open regkey error:'+'SOFTWARE\PaulsYard\BackUpDB\'+S1[i]);
BackUpDataBase:=R.ReadString('DataBaseName');
ServerName:=R.ReadString('ServerName');
S2:=TStringList.Create;
R.CloseKey;
try
if not R.OpenKey('SOFTWARE\PaulsYard\BackUpDB\'+S1[i]+'\BackUpFiles',FALSE) then
Raise Exception.Create('Open regkey error:'+'SOFTWARE\PaulsYard\BackUpDB\'+S1[i]+'\BackUpFiles');
R.GetValueNames(S2);
for j:=0 to S2.Count-1 do
begin
BackUpFile:=R.ReadString(S2[j]);
c:=Pos('*',BackUpFile);
if c>0 then
begin
Delete(BackUpFile,c,1);
Insert(IntToStr(DayOfWeek(now)),BackUpFile,c);
end;
BuckUp(ServerName,BackUpDataBase,BackUpFile);
end;
R.CloseKey;
finally
S2.Free;
end;
end;
finally
S1.Free;
end;
end else Raise Exception.Create('Open regkey error:'+'"HKEY_LOCAL_MACHINE\SOFTWARE\PaulsYard\BackUpDB"');
finally
R.Free;
end;
backupStart:=FALSE;
except
on e:Exception do
LogMessage(e.Message);
end;
end;
procedure TBackUpService.BuckUp(ServerName, DataBaseName,
BackUpFileName: String);
var
FS:TFileStream;
SS:TStringList;
begin
LogMessage(#13'Backup starting: '#13#09+DataBaseName,EVENTLOG_INFORMATION_TYPE);
SS:=TStringList.Create;
try
if not FileExists(LogFile) then
FS:=TFileStream.Create(LogFile,fmCreate)
else
begin
FS:=TFileStream.Create(LogFile,fmOpenWrite);
FS.Seek(0,soFromEnd);
end;
try
SS.Clear;
IBBackupService1.ServerName:=ServerName;
IBBackupService1.DatabaseName:=DataBaseName;
IBBackupService1.BackupFile.Clear;
IBBackupService1.BackupFile.Add(BackUpFileName);
IBBackupService1.Attach;
try
if IBBackupService1.Active then
Begin
IBBackupService1.ServiceStart;
if IBBackupService1.Verbose then
while not IBBackupService1.Eof do
SS.Add(IBBackupService1.GetNextLine)
else
while IBBackupService1.IsServiceRunning do
ServiceThread.ProcessRequests(FALSE);
End;
finally
if IBBackupService1.Active then
IBBackupService1.Detach;
SS.SaveToStream(FS);
end;
finally
FS.Free;
end;
finally
SS.Free;
end;
LogMessage(#13'Backup successful end: '#13#09+DataBaseName,EVENTLOG_INFORMATION_TYPE);
end;
Если вы заметили орфографическую ошибку на этой странице, просто выделите ошибку мышью и нажмите Ctrl+Enter. Функция может не работать в некоторых версиях броузеров.
