paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-30 23:30:18 +02:00
Code Issues Packages Projects Releases Wiki Activity

* Publish and observe port

Browse Source 
git-svn-id: trunk@35419 -
This commit is contained in:
michael 2017-02-11 09:45:13 +00:00
parent f5b76b62fe
commit faa70adcd3
1 changed files with 12 additions and 2 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
packages/fcl-db/src/sqldb/interbase/ibconnection.pp
View File

@ -131,6 +131,7 @@ type
property LoginPrompt;
property Params;
property OnLogin;
Property Port;
end;
{ TIBConnectionDef }
@ -611,6 +612,8 @@ procedure TIBConnection.ConnectFB;
var
ADatabaseName: String;
DPB: string;
HN : String;
begin
DPB := chr(isc_dpb_version1);
if (UserName <> '') then
@ -625,8 +628,15 @@ begin
DPB := DPB + Chr(isc_dpb_lc_ctype) + Chr(Length(CharSet)) + CharSet;
FDatabaseHandle := nil;
if HostName <> '' then ADatabaseName := HostName+':'+DatabaseName
else ADatabaseName := DatabaseName;
HN:=HostName;
if HN <> '' then
begin
if Port<>0 then
HN:=HN+'/'+IntToStr(Port);
ADatabaseName := HN+':'+DatabaseName
end
else
ADatabaseName := DatabaseName;
if isc_attach_database(@FStatus[0], Length(ADatabaseName), @ADatabaseName[1],
@FDatabaseHandle, Length(DPB), @DPB[1]) <> 0 then
CheckError('DoInternalConnect', FStatus);