Is it possible to use TFDFBNBackup and TFDFBNRestore for creating and restoring backups from/to a remote server from local files?
I know that this can be done with the local service manager command line tool like gbak also allows this, but I do not want to use these tools in my new Firemonkey application (Windows, OSX, Linux). I want to compile the functionality completely into my application and I only will have access to the server on a Firebird connection basis, no file share.
Thanks to Arioch's suggestion I could solve it and it works well. I used gbak service as it compresses the backup file. Should work with the nbackup flavour as well.
Below please find some example code without any error handling as proof of concept. As Backup only makes sense if it is absolutely reliable a sophisticated error detection and handling is neccessary when implementing this concept for production purposes.
Also, one has to modify firebird.conf on the server to allow external file access in the folder where the database(s) reside. I created backups of some databases in Windows and a binary compare of the files transferred to the local machine.
In the example I feed a label and a progress bar. The backup component should be set to verbose to display the progress although this slows down the backup on the server I prefer being able to give feedback to the user.
procedure TForm1.Button1Click(Sender: TObject);
var
count: int64;
fs: TFileStream;
x: integer;
procedure dropBackupTable;
begin
with FDQuery do
begin
sql.text := 'execute block as ' + 'begin ' +
'if (exists(select 1 from rdb$relations where rdb$relation_name=''BACKUP'')) then ' +
'execute statement ''drop table backup'';' + 'end';
execute;
end;
end;
begin
lbl.text := 'Online backup on server...';
dropBackupTable;
pb.Value := 2;
pb.Max := 2000;
with FDIbBackup do
begin
host := '192.168.2.14';
database := 'r:\databases\office.fdb';
port := 1216;
UserName := 'SYSDBA';
Password := '???????';
BackupFiles.Clear;
BackupFiles.add('r:\databases\back.fbk');
Backup;
end;
lbl.text := 'Copying backup file...';
with FDQuery do
begin
sql.text := 'create table backup external ''r:\databases\back.fbk'' (x integer)';
execute;
sql.text := 'select count(*) from backup';
open;
count := fields[0].AsInteger;
close;
pb.Max := count div 1024;
pb.Value := 0;
sql.text := 'select * from backup';
open;
fs := TFileStream.create('d:\temp\local.fbk', fmCreate, (fmShareDenyRead or fmShareDenyNone));
count := 0;
while not eof do
begin
inc(count);
x := fields[0].AsInteger;
fs.write(x, sizeOf(x));
if count > 1023 then
begin
pb.Value := pb.Value + 1;
application.processmessages;
count := 0;
end;
next;
end;
close;
fs.free;
pb.Value := 0;
end;
dropBackupTable;
lbl.text := 'Ready.';
end;
procedure TForm1.FBBackProgress(ASender: TFDPhysDriverService; const AMessage: string);
begin
if pb.Value = pb.Max then
pb.Value := 2
else
pb.Value := pb.Value + 1;
application.processmessages;
end;
Related
I'm trying to implement UDP Hole Punching with Delphi with Indy and Firemonkey technology.
I have tried to follow this document: https://www.researchgate.net/publication/1959162_Peer-to-Peer_Communication_Across_Network_Address_Translators
The program seems to work but is NOT stable.
If I work on a system on the local intranet no problem.
If I work on an internet, it doesn't always work and I don't know why.
I have created two applications.
The first is server side.
Everytime all clients connect correctly to server.
The server registers the Local IP and Internet IP pairs in a variable (fPeers).
I created an IdUDPServer instance.
This is the “Connect push button” code:
procedure TForm1.B_ConnectClick(Sender: TObject);
var
vIdSocketHandle: TIdSocketHandle;
begin
if IdUDPServer.Active then
begin
IdUDPServer.Active := False;
B_Connect.Text := 'Connect';
end
else
begin
IdUDPServer.Bindings.Clear;
vIdSocketHandle := IdUDPServer.Bindings.Add;
vIdSocketHandle.IP := GStack.LocalAddress;
vIdSocketHandle.Port := E_POrt.Text.ToInteger;
IdUDPServer.Active := True;
B_Connect.Text := 'Disconnect';
end;
end;
During the IdUDPServerUDPRead event I capture the Local and Internet IP addresses of the clients that connect.
In the TStringLIST called fPeerIP I add the list of addresses.
procedure TForm1.IdUDPServerUDPRead(AThread: TIdUDPListenerThread;
const AData: TIdBytes; ABinding: TIdSocketHandle);
var vPair: string;
vData: string;
vString: string;
vLog: string;
begin
vPair := ABinding.PeerIP + ':'+ABinding.PeerPort.ToString;
vData := BytesToString(AData);
vLog := '';
if leftstr(vdata,7) = 'LOCALIP' then
begin
vString := vPair+#9+lsExtract(vData,2,',');
if fPeerIP.IndexOfName(vString) = -1 then
begin
fPeerIP.Add(vString);
M_Peers.Lines.Add(vString);
vLog := vLog + vString + #13#10;
IdUDPServer.Send(ABinding.PeerIP, ABinding.PeerPort, 'Peer aggiunto alla lista');
end;
end
else vLog := vData;
end;
On the client side, I created an IdUDPServer instance which, upon connection, sends a string to the server.
procedure TForm2.B_ConnectClick(Sender: TObject);
var vIdSocketHandle: TIdSocketHandle;
vLocalAddressList: TIdStackLocalAddressList;
vI: Integer;
vSendLIST: TStringLIST;
begin
if IdUDPServer.Active then
begin
Timer.Enabled := False;
IdUDPServer.Active := False;
B_Connect.Text := 'Connect';
M_Networks.Lines.Clear;
M_Debug.Lines.Clear;
LB_Peers.Items.Clear;
end
else
begin
try
vSendLIST := TStringLIST.Create;
IdUDPServer.Bindings.Clear;
vLocalAddressList := TIdStackLocalAddressList.Create;
GStack.GetLocalAddressList(vLocalAddressList);
M_Networks.Lines.Clear;
for vI := 0 to vLocalAddressList.Count-1 do
begin
if vLocalAddressList.Addresses[vI].IPVersion = id_IPV4 then
begin
M_Networks.Lines.Add(vLocalAddressList.Addresses[vI].IPAddress);
vSendLIST.Add(Format('LOCALIP,%s:%d',[vLocalAddressList.Addresses[vI].IPAddress,E_ClientPort.Text.ToInteger]));
end;
end;
vIdSocketHandle := IdUDPServer.Bindings.Add;
vIdSocketHandle.Port := E_ClientPort.Text.ToInteger;
vIdSocketHandle.IP := '0.0.0.0';
IdUDPServer.Active := True;
for vI := 0 to vSendLIST.Count-1 do
IdUDPServer.Send(E_Server.Text, E_Port.Text.ToInteger, vSendLIST[vI]);
B_Connect.Text := 'Disconnect';
if Assigned(vSendLIST) then FreeAndNil(vSendLIST);
finally
if Assigned(vLocalAddressList) then FreeAndnil(vLocalAddressList);
end;
end;
end;
Also on the client side, in the IdUDPServerUDPRead event I detect the list of Peers (function sent by the server) and send a "PING" to each connected peer.
I realize maybe I have given little information.
I'd like to know your opinion and possibly indicate to me if I made a mistake in the process that activates the Hole Punching.
Thanks in advance
LS
Your code is theoretically right and may work on some NAT routers but it will not work on the rest
I have been trying to achieve UDP Hole Punching for many years but it's really complicated,
you need to combine many NAT Traversal mechanisms together to make it work in the most cases
Reading about STUN, TURN and ICE mechanisms may help
Some example code, that works in a regular (local) session:
constructor TForm1.Create(AOwner: TComponent);
begin
inherited;
ChangeWindowMessageFilter(WM_DROPFILES, MSGFLT_ADD);
ChangeWindowMessageFilter(WM_COPYDATA, MSGFLT_ADD);
ChangeWindowMessageFilter(WM_COPYGLOBALDATA, MSGFLT_ADD);
DragAcceptFiles(Handle, True);
end;
destructor TForm1.Destroy;
begin
DragAcceptFiles(Handle, False);
inherited;
end;
procedure TForm1.GetDropFilenames(const ADropHandle: HDROP);
var
I, LFileCount, LLength: integer;
LFilename: string;
begin
LFileCount := DragQueryFile(ADropHandle, $FFFFFFFF, nil, 0);
for I := 0 to LFileCount - 1 do
begin
LLength := DragQueryFile(ADropHandle, I, nil, 0) + 1;
SetLength(LFilename, LLength);
DragQueryFile(ADropHandle, I, PChar(LFilename), LLength);
LLength := Pos(#0, LFileName);
if LLength > 0 then
LFilename := LFilename.Substring(0, LLength - 1);
LogMemo.Lines.Add('Filename Copied To Clipboard: ' + LFilename);
end;
end;
procedure TForm1.WMDropFiles(var Msg: TWMDropFiles);
begin
GetDropFilenames(Msg.Drop);
Msg.Result := 0;
inherited;
end;
i.e. dropping some files onto the app results in the filenames being added to the memo.
I want to be able to have the app running on a remote machine, and drag files from the local machine into the app in the remote desktop session. I just need it to operate via drag/drop, and have the names of the files accessible as per when it runs locally; what I actually do with the filenames isn't relevant.
Someone suggested that making the app run with elevated privileges would make it work, except that (for me), it does not.
The remote machine is running Windows Server 2019.
Is there something else I need to do to make this work?
I have an interesting problem. I have to take a signature image that is saved in Sqlite3 database.
When you view the saved signature on the Sqlite3 database it is a signature. The database is uploaded to a server that has MSSQL Server which then reads the signature image. Unfortunately this image appears totally black on the server and it comes back the same. The db administrator says that the data appears to be garbage (includes unicode characters).
Example of the image data is:
Sent Data: Tried to include but unfortunately it will not show unicode. It is thousands of bytes long.
Returned Data: *System.Byte[]* <<and that is it - 26 bytes long.
My guess is that the unicode is responsible. Not sure how to resolve this issue.
The data connection component is TSQLConnection. The query component is TSQLQuery. I am using XE5 building a Firemonkey iOS mobile application.
Here is my code. Appreciate any help.
function SaveSig: boolean;
var
fStream: TMemoryStream;
begin
Result := False;
fStream := TMemoryStream.Create;
try
try
fStream.Seek(0, soFromBeginning);
fStream.Position := 0;
if Assigned(imgSig) then
begin
imgSig.Bitmap.SaveToStream(fStream);
Result := SqlInsertSig(fStream);
end;
except
on e: Exception do
ShowMessage(ERROR_BITMAP + e.Message);
end;
finally
if Assigned(fStream) then
FreeAndNil(fStream);
end;
end;
function SqlInsertSig(const ms: TMemoryStream): boolean;
begin
Result := False;
try
try
sq.Active := False;
sq.CommandText := 'Insert Into Signatures (Id, Sig) Values (' +
QuotedStr(IntToStr(Id)) + ', :sig)';
sq.Params.ParamByName('sig').LoadFromStream(ms, ftBlob);
Result := (sq.ExecSQL > 0);
except
on e: Exception do
MessageDlg(e.Message, TMsgDlgType.mtError, [TMsgDlgBtn.mbOK], 0);
end;
finally
sq.Active := False;
end;
end;
I have a small application that is used to process some files made in another program.
I use an older component by Angus Johnson called TDirectoryWatch
On my FormCreate I have the following code
DirectoryWatch := TDirectoryWatch.Create(self);
DirectoryWatch.OnChange := FileAction;
DirectoryWatch.Directory := Folders.Path(dirInput);
DirectoryWatch.Active := True;
If the program is started and there is put a new file in the directory everything fires and runs OK.
But if there is a file in the directory when the program is started nothing happens even if I make a call to FileAction(nil);
FileAction is the name of the procedure that handles the files
I have a call to FileAction from a popupmenu and that handles the files in the directory
So my question is: how to make sure that existing files are handled at program start?
Or is there a better way to handle this problem.
Added code for FileAction
procedure TfrmMain.FileAction(Sender: TObject);
var
MailFile: string;
MailInfo: TMailInfo;
ListAttachments: TstringList;
i: integer;
MailBody: string;
begin
for MailFile in TDirectory.GetFiles(Folders.Path(dirInput), CheckType) do
begin
if FileExists(MailFile) then
begin
MailInfo := TMailInfo.Create(MailFile);
try
if FileProcessing = False then
begin
Logfile.Event('Behandler fil: ' + MailFile);
FileProcessing := True;
MailBody := '';
Settings.Load;
MailInfo.Load;
Settings.Mail.Signature := '';
Settings.Mail.Subject := MailInfo.Subject;
ListAttachments := TStringList.Create;
ListAttachments.Clear;
for i := 1 to MaxEntries do
begin
if (MailInfo.Attachment[i] <> '') and (FileExists(MailInfo.Attachment[i])) then
ListAttachments.Add(MailInfo.Attachment[i]);
end;
for i := 1 to MaxEntries do
begin
MailBody := MailBody + MailInfo.MailBody[i];
end;
try
if MailBody <> '' then
begin
if MailInfo.SenderBcc then
Mailing.Send(MailInfo.SenderMail, MailInfo.Recipient, MailInfo.SenderMail, MailInfo.Subject, MailBody, ListAttachments, True)
else
Mailing.Send(MailInfo.SenderMail, MailInfo.Recipient, MailInfo.Subject, MailBody, ListAttachments, True);
end;
finally
ListAttachments.Free;
end;
FileProcessing := False;
DeleteFile(MailFile);
end;
finally
MailInfo.Free;
end;
end;
end;
end;
The component doesn't notify about changes when your program starts up because at the time your program starts, there haven't been any changes yet.
Your policy appears to be that at the time your program starts up, all existing files are to be considered "new" or "newly changed," so your approach of manually calling the change-notification handler is correct.
The only thing the component does when it detects a change is to call the change-notification handler. If you explicitly call that function, and yet you still observe that "nothing happens," then there are more deep-seated problems in your program that you need to debug; it's not an issue with the component or with the basic approach described here.
We are trying to write an update server for our software using the TIdHTTPServer component. Currently we are serving an XML file that lists the available updates and their file versions etc.., when the client program finds a updated version it should start to download it using BITS.
Now this is where we have a problem, our programs are requesting the XML file and seeing there is an update available. It then creates a BITS job to download it, however BITS keeps reporting that the download failed. We can download the file using the same URL and IE/Firefox/Chrome.
so my question:
Is TIdHTTPServer compatible with BITS?
I ask this as I have discovered that there are these download requirements for bits to work.
HTTP Requirements for BITS Downloads
BITS supports HTTP and HTTPS downloads and uploads and requires that the server supports the HTTP/1.1 protocol. For downloads, the HTTP server's Head method must return the file size and its Get method must support the Content-Range and Content-Length headers. As a result, BITS only transfers static file content and generates an error if you try to transfer dynamic content, unless the ASP, ISAPI, or CGI script supports the Content-Range and Content-Length headers.
BITS can use an HTTP/1.0 server as long as it meets the Head and Get method requirements.
To support downloading ranges of a file, the server must support the following requirements:
Allow MIME headers to include the standard Content-Range and Content-Type headers, plus a maximum of 180 bytes of other headers.
Allow a maximum of two CR/LFs between the HTTP headers and the first boundary string.
Just found a bug in indy that prevents transfer of files over 2.1GB when using range requests.
here it is
IdHTTPHeaderInfo.pas aprox line 770
procedure TIdEntityRange.SetText(const AValue: String);
var
LValue, S: String;
begin
LValue := Trim(AValue);
if LValue <> '' then
begin
S := Fetch(LValue, '-'); {do not localize}
if S <> '' then begin
FStartPos := StrToIntDef(S, -1);
FEndPos := StrToIntDef(Fetch(LValue), -1);
FSuffixLength := -1;
end else begin
FStartPos := -1;
FEndPos := -1;
FSuffixLength := StrToIntDef(Fetch(LValue), -1);
end;
end else begin
FStartPos := -1;
FEndPos := -1;
FSuffixLength := -1;
end;
end;
This should be
procedure TIdEntityRange.SetText(const AValue: String);
var
LValue, S: String;
begin
LValue := Trim(AValue);
if LValue <> '' then
begin
S := Fetch(LValue, '-'); {do not localize}
if S <> '' then begin
FStartPos := StrToInt64Def(S, -1);
FEndPos := StrToInt64Def(Fetch(LValue), -1);
FSuffixLength := -1;
end else begin
FStartPos := -1;
FEndPos := -1;
FSuffixLength := StrToInt64Def(Fetch(LValue), -1);
end;
end else begin
FStartPos := -1;
FEndPos := -1;
FSuffixLength := -1;
end;
end;
One for Remy to fix
When you handle the OnCommandGet event, you are given a TIdRequestHeaderInfo, which descends from TIdEntityHeaderInfo; that contains all the headers the request contained, and it even parses out some header values to read as properties, including ContentRangeStart, ContentRangeEnd, and ContentLength.
You can use those properties to populate the stream that you assign to the TIdHTTPResponseInfo.ContentStream property. The entire stream will get sent.
It's your job to differentiate between GET and HEAD requests; OnCommandGet will get triggered either way. Check the IdHTTPRequestInfo.CommandType property.
So, although Indy may not support BITS, it provides all the tools you need to write a program that does support BITS.
So the answer to this question is:
Yes TIdHTTPServer is Bits Compatible.
But only if you are prepared to do the work yourself.
As suggested by #Rob Kennedy and Myself it is possible to read the headers and send the data back using the requested ranges, one chunk at a time.
Here is an example of what I am doing in the OnCommandGet event
procedure TForm3.IdHTTPServer1CommandGet(AContext: TIdContext;
ARequestInfo: TIdHTTPRequestInfo; AResponseInfo: TIdHTTPResponseInfo);
var
Ranges : TIdEntityRanges;
DataChunk: TMemoryStream;
ReqFile: TFileStream;
ChunkLength: Int64;
Directory, FileName: string;
begin
Directory := 'H:';
case ARequestInfo.Ranges.Count of
0:
begin
//serve file normally
end;
1:
begin
//serve range of bytes specified for file
filename := Directory + ARequestInfo.Document;
if FileExists(FileName) then
begin
ReqFile := TFileStream.Create(FileName, fmOpenRead);
try
ChunkLength := Succ(ARequestInfo.Ranges.Ranges[0].EndPos - ARequestInfo.Ranges.Ranges[0].StartPos);
if ChunkLength > ReqFile.Size then
ChunkLength := ReqFile.Size;
DataChunk := TMemoryStream.Create;
DataChunk.Posistion := ARequestInfo.Ranges.Ranges[0].StartPos;
DataChunk.CopyFrom(ReqFile, ChunkLength);
AResponseInfo.ContentStream := DataChunk;
AResponseInfo.ContentType := IdHTTPServer1.MIMETable.GetFileMIMEType(FileName);
AResponseInfo.ContentRangeUnits := ARequestInfo.Ranges.Units;
AResponseInfo.ContentRangeStart := ARequestInfo.Ranges.Ranges[0].StartPos;
AResponseInfo.ContentRangeEnd := ARequestInfo.Ranges.Ranges[0].StartPos + Pred(ChunkLength);
AResponseInfo.ContentRangeInstanceLength := ReqFile.Size;
AResponseInfo.ResponseNo := 206;
finally
ReqFile.Free;
end;
end
else
AResponseInfo.ResponseNo := 404;
end
else
begin
//serve the file as multipart/byteranges
end;
end;
end;
This is by no means finished but it shows the basics of responding to the range requests from BITS. Most importantly it works.
Any comments on the code would be appreciated, constructive criticism always welcome.