Make a ODBC connection from a delphi-7 application throu ADOConnectionstring - delphi

Background :
Application written in Delphi-7 or -6 (have search through the .exe file). Called Sigmanest.
I have moved to new server and that's left is SigmaNest database running under SQL server. After many hours of troubleshooting for migrate that database to new server. The trouble have covered all aspect of this SQL server app. services not started at default, non working wizard, lack of full-text something, ridiculous many places to right click etc .. The lost goes on and on.
At the moment I have a working SQL server with the database SNDBase (sigmanest) at the new hardware but not be able to connect from client.
Na this can't be right I thought and searched for alternatives.. 4-5 click in MySQL workbench and I have it up an running on test linux box... Fine ..
But now it comes to problem.
SigmaNest uses a ini files for its config.
So inside one ini file I found
; 1 = Paradox, 2 = MSSQLServer or MSDE
ADOConnectionString=Provider=SQLOLEDB.1;Data Source=ODIN\SIGMANEST;User ID=sigmanest;Password="";Persist Security Info=True;Initial Catalog=SNDBase;
Okej .. installed Mysql odbc driver on the client and made the connection . All working so far ..
Turned to google and found the ADOConnectionsstring for mysql ...
ADOConnectionString=DRIVER={MySQL ODBC 5.2a Driver};SERVER=192.168.100.19;PORT=3306;DATABASE=SNDBase;UID=sigmanest;PASSWORD=;OPTION=4;
But the app will not start . just return to sigmanest's config tool for db connection.
Have posted this to SigmaTek but the only response I have been giving is a mail with ADOConnection string for MS sql server through SQLOLEDB.
Have searched the drive and haven't found anny dbex*.dll files witch means that they don't uses dbExpress component (my guess).
So is there some missing dll files that didn't come with the app. Or is this kind of thing hardcoded inside the program?
Anyone having a idea how to proceed ?
Or should I drop the mysql dream and go for the waste of space sql server backend.
Per Nils
PS.
The SigmaNest.exe have a time stamp 2006-05-19
DS.

Sorry but I didn't know where to go with this issue. And stackoverflow seems to have gadder ed all the talent people in the world under the same roof so to speak.
Ken White : Yes you are right I can't use MySQL on this application (after hours of googling and testing).
Anyway I managed to make the connection like this (maybe something is usefully for others some of it is Delphi related)
First you have to download the mysql connector http://dev.mysql.com/downloads/connector/odbc/
Make a ODBC conenction from control panel-> administration tools -> Data sources (ODBC) under tab "User DSN"
The you make a new text file with notepad.
Rename the file with extension .udl
Double click on it and fill in the dialog boxes ...
Open the file in notepad and there you have your adoconnection string.
But your problem is not over.. Difference in SQL vs MySQL will make your app to halt .. for example boolean in MySQL is declared as a tinyint (0=false 1=true)
A workaround is mention here http://www.i-logic.com/utilities/MySQL.htm
So my struggle gave nothing in return but some of above could be a interested for others.
Per Nils ..

ODBC can be configured at runtime, below is an example of configuring ODBC to connect to SQL Server using BDE.
unit uBDEConnectionSqlServer;
interface
uses
DBTables, Windows, Classes, SysUtils;
type TBDEConnectionSqlServer = class(TComponent)
private
{ Private declarations }
function CreateOBDCConnection(dataBase : string; server: string):Boolean;
public
{ Public declarations }
Function CreateBDEConnection(dataBase: TDatabase; dataBaseName : string; server:string; userName:string; password:string): Boolean;
end;
const
ODBC_ADD_DSN = 1; // Add data source
ODBC_CONFIG_DSN = 2; // Configure (edit) data source
ODBC_REMOVE_DSN = 3; // Remove data source
ODBC_ADD_SYS_DSN = 4; // add a system DSN
ODBC_CONFIG_SYS_DSN = 5; // Configure a system DSN
ODBC_REMOVE_SYS_DSN = 6; // remove a system DSN
ODBC_REMOVE_DEFAULT_DSN = 7; // remove the default DSN
function SQLConfigDataSource(
hwndParent: HWND;
fRequest: WORD;
lpszDriver: LPCSTR;
lpszAttributes: LPCSTR): BOOL; stdcall; external 'ODBCCP32.DLL';
implementation
Function TBDEConnectionSqlServer.CreateBDEConnection(dataBase: TDatabase; dataBaseName : string; server:string; userName:string; password:string): Boolean;
var
retorno: TDatabase;
Begin
result := false;
if (CreateOBDCConnection(dataBaseName, server) = true) then
begin
dataBase.AliasName := 'testedelphi';
dataBase.LoginPrompt := False;
dataBase.DatabaseName := 'testedelphi';
dataBase.Params.Values['DATABASE NAME'] := dataBaseName;
dataBase.Params.Values['USER NAME'] := userName;
dataBase.Params.Values['ODBC DSN'] := dataBaseName;
dataBase.Params.Values['OPEN MODE'] := 'READ/WRITE';
dataBase.Params.Values['BATCH COUNT'] := '200';
dataBase.Params.Values['LANGDRIVER'] := '';
dataBase.Params.Values['MAX ROWS'] := '-1';
dataBase.Params.Values['SCHEMA CACHE DIR'] := '';
dataBase.Params.Values['SCHEMA CACHE SIZE'] := '8';
dataBase.Params.Values['SCHEMA CACHE TIME'] := '-1';
dataBase.Params.Values['SQLPASSTHRU MODE'] := 'SHARED AUTOCOMMIT';
dataBase.Params.Values['SQLQRYMODE'] := '';
dataBase.Params.Values['ENABLE SCHEMA CACHE'] := 'FALSE';
dataBase.Params.Values['ENABLE BCD'] := 'FALSE';
dataBase.Params.Values['ROWSET SIZE'] := '20';
dataBase.Params.Values['BLOBS TO CACHE'] := '64';
dataBase.Params.Values['BLOB SIZE'] := '32';
dataBase.Params.Values['PASSWORD'] := password;
result := true;
end;
end;
function TBDEConnectionSqlServer.CreateOBDCConnection(dataBase : string; server: string):Boolean;
var
resultado: BOOL;
begin
Result := False;
resultado := SQLConfigDataSource(
0,
ODBC_ADD_DSN,
'SQL Server',
PChar(
'DSN='+dataBase+#0 +
'SERVER='+server+#0 +
'ADDRESS='+server+#0 +
'NETWORK=dbmssocn'#0 +
'DATABASE='+dataBase+#0 +
'DESCRIPTION='+server+dataBase+#0 +
#0
)
);
if(StrToInt(BoolToStr(resultado)) <> 0) then
Result := True;
end;
end.

Related

How to fix "No more files" error in Delphi application with Paradox tables on Windows 10 1803?

In old Delphi applications which use the old and deprecated but still used BDE database engine with Paradox database files residing on a Windows 10 computer that's updated to the 1803 "Spring Creators Update" version, but the client computers using any older version of Windows like Windows 10 1709 or Windows 7, opening a Paradox table sometimes fails with a "No more files" error, idapi32.dll error code DBIERR_OSENMFILE. This raises a EDBEngineError exception in DBTables.pas / TTable.GetHandle(), which is called by TTable.CreateHandle, called by TBDEDataSet.OpenCursor().
The error seems to be caused by some file-sharing related changes in the Windows 10 1803 update. Removing the 1803 update from the file-sharing Windows 10 computer, or updating all the client computers to Windows 10 + 1803 seems to make the error go away.
People have speculated that the changes have something to do with the SMB protocol, maybe Windows Defender and/or other security related issues. Here's a Google Plus discussion
https://plus.google.com/106831056534874810288/posts/F4nsoTz2pDi
How could the "No more files" error be worked around by some reasonably easily doable changes in the Delphi application, while allowing the file-sharing client and server computers to keep using heterogeneous Windows versions?
Please try to refrain from answering or commenting self-evident things like "the sky is blue" or "BDE is old and deprecated". Keeping BDE is a decision that cannot be changed, certainly not as a "bug fix".
As an emergency fix, we have resorted to simply re-trying DbiOpenTable, when it returns the DBIERR_OSENMFILE error code. I posted an answer with source code to the idapi32.dll hack. So far it seems that if the first DbiOpenTable says "No more files", the second try succeeds, and the application works without noticing anything.
WARNING: what follows is a hack. A kludge. Band-aid, glue, duct tape and chewing gum. BDE is old. You are completely on your own if you use BDE and/or if you try this hack. I accept no responsibility over its use. If it works for you, good for you. If it ruins your business, bad for you.
Since the Paradox tables still mostly worked and the error seemed to be slightly randomly triggered, and since someone suspected Windows Defender having something to do with it, I thought maybe it just needs some kicking around. If DbiOpenTable() suddenly starts sometimes failing over a certain combination of SMB client/server versions, because "No more files" ... then why not just try the file operation again. I put an "if it returns a DBIERR_OSENMFILE error, then Sleep() and try again" logic around the DbiOpenTable function, and guess what - it seemed to work.
Hacking around the BDE's "features" is familiar to anyone who has to maintain BDE based applications. So I made a patching hook around idapi32.dll's DbiOpenTable function, starting from an old routine written by Reinaldo Yañez originally to fix the "insufficient disk space" error with BDE when the free disk space is at a 4 GB boundary. See https://cc.embarcadero.com/Item/21475
To use this, add Fix1803 in a uses clause, and call PatchBDE somewhere before starting to open Paradox tables. Maybe call UnPatchBDE when you're done, though I don't think that's necessary.
But remember, you're on your own, and this is highly experimental code.
unit Fix1803;
// * KLUDGE WARNING *
// Patch (hack) idapi32.dll DbiOpenTable() to try harder, to work with Windows 10 1803 "Spring Creators Update".
//
// The patching routine is an extension of code originally written by Reinaldo Yañez.
// see https://cc.embarcadero.com/Item/21475
//
// Some original Spanish comments are left in place.
interface
procedure PatchBDE;
procedure UnPatchBDE;
implementation
uses
Windows, Db, DbTables, BDE, SysUtils;
// ------------------------------------------- DbiOpenTable hook
var DbiOpenTable_address_plus_9 : Pointer;
function Actual_DbiOpenTable_CallStub(hDb: hDBIDb; pszTableName: PChar; pszDriverType: PChar; pszIndexName: PChar; pszIndexTagName: PChar; iIndexId: Word; eOpenMode: DBIOpenMode; eShareMode: DBIShareMode; exltMode: XLTMode; bUniDirectional: Bool; pOptParams: Pointer; var hCursor: hDBICur): DBIResult stdcall; assembler;
asm
// these two instructions are implicitly contained in the start of the function
// push ebp
// mov ebp, esp
add esp, $fffffee8
jmp dword ptr [DbiOpenTable_address_plus_9]
end;
function LogHook_DbiOpenTable (hDb: hDBIDb; pszTableName: PChar; pszDriverType: PChar; pszIndexName: PChar; pszIndexTagName: PChar; iIndexId: Word; eOpenMode: DBIOpenMode; eShareMode: DBIShareMode; exltMode: XLTMode; bUniDirectional: Bool; pOptParams: Pointer; var hCursor: hDBICur): DBIResult stdcall;
var
i : Integer;
begin
Result := Actual_DbiOpenTable_CallStub(hDb, pszTableName, pszDriverType, pszIndexName, pszIndexTagName, iIndexId, eOpenMode, eShareMode, exltMode, bUniDirectional, pOptParams, hCursor);
// if we got the "No more files" error, try again... and again.
i := 1;
while (Result = DBIERR_OSENMFILE) and (i < 10) do
begin
Windows.Sleep(i);
Result := Actual_DbiOpenTable_CallStub(hDb, pszTableName, pszDriverType, pszIndexName, pszIndexTagName, iIndexId, eOpenMode, eShareMode, exltMode, bUniDirectional, pOptParams, hCursor);
Inc(i);
end;
end;
// ------------------------------------------- Patching routines
const // The size of the jump instruction written over the start of the original routine is 5 bytes
NUM_BYTES_OVERWRITTEN_BY_THE_PATCH = 5;
type
TRYPatch = record
OrgAddr: Pointer;
OrgBytes: array[0..NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1] of Byte;
end;
procedure TRYPatch_Clear(var ARYPatch : TRYPatch);
begin
FillChar(ARYPatch, SizeOf(TRYPatch), 0);
end;
function RedirectFunction(OldPtr, NewPtr, CallOrigStub : Pointer; var OriginalRoutineAddressPlusN: Pointer; NumBytesInCompleteInstructionsOverwritten : Integer): TRYPatch;
type
PPtr=^pointer;
PPPtr=^PPtr;
TByteArray=array[0..maxint-1] of byte;
PByteArray=^TByteArray;
function SameBytes(Ptr1, Ptr2 : Pointer; NumBytes : Integer) : Boolean;
var
i : Integer;
begin
Result := true;
i := 0;
while (Result) and (i < NumBytes) do
begin
Result := Result and ((PByteArray(Ptr1)^[i] = PByteArray(Ptr2)^[i]));
Inc(i);
end;
end;
var
PatchingAddress : Pointer;
OldProtect,
Protect : DWORD;
p: PByteArray;
i : Integer;
begin
PatchingAddress := OldPtr;
if PWord(PatchingAddress)^ = $25FF then
begin {Es un JMP DWORD PTR [XXXXXXX](=> Esta utilizando Packages)}
p := PatchingAddress;
PatchingAddress := (PPPtr(#p[2])^)^; // PatchingAddress now points to the start of the actual original routine
end;
// Safety check (as if this thing was "safe"). The given replacement routine must start with the same bytes as the replaced routine.
// Otherwise something is wrong, maybe a different version of idapi32.dll or something.
if (CallOrigStub <> nil) and not SameBytes(PatchingAddress, CallOrigStub, NumBytesInCompleteInstructionsOverwritten) then
raise Exception.Create('Will not redirect function, original call stub doesn''t match.');
// Change memory access protection settings, so we can change the contents
VirtualProtect(PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, PAGE_READWRITE, #OldProtect);
// Save the old contents of the first N bytes of the routine we're hooking
Result.OrgAddr := PatchingAddress; // Save the address of the code we're patching (which might not be the same as the original OldPtr given as parameter)
for i := 0 to NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1 do
result.OrgBytes[i] := PByte(Integer(PatchingAddress) + i)^;
// Replace the first bytes of the original function with a relative jump to the new replacement hook function
// First write the instruction opcode, $E9 : JMP rel32
PByte(PatchingAddress)^:= $E9;
// Then write the instruction's operand: the relative address of the new function
PInteger(Integer(PatchingAddress)+1)^ := Integer(NewPtr) - Integer(PatchingAddress) - 5;
// Address to jump to, for the replacement routine's jump instruction
OriginalRoutineAddressPlusN := Pointer(Integer(PatchingAddress) + NumBytesInCompleteInstructionsOverwritten);
// Restore the access protection settings
VirtualProtect(PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, OldProtect, #Protect);
FlushInstructionCache(GetCurrentProcess, PatchingAddress, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH);
end;
procedure RestorePatch(RestorePatch: TRYPatch);
var
OldProtect,
Protect : DWORD;
OldPtr: Pointer;
i : Integer;
begin
OldPtr := RestorePatch.OrgAddr;
VirtualProtect(OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, PAGE_READWRITE, #OldProtect);
for i := 0 to NUM_BYTES_OVERWRITTEN_BY_THE_PATCH-1 do
PByte(Integer(OldPtr) + i)^ := RestorePatch.OrgBytes[i];
VirtualProtect(OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH, OldProtect, #Protect);
FlushInstructionCache(GetCurrentProcess, OldPtr, NUM_BYTES_OVERWRITTEN_BY_THE_PATCH);
end;
var
idapi32_handle: HMODULE;
Patch_DbiOpenTable : TRYPatch;
procedure PatchBDE;
begin
if idapi32_handle <> 0 then Exit; // already_patched
idapi32_handle := LoadLibrary('idapi32');
if idapi32_handle <> 0 then
begin
Patch_DbiOpenTable := RedirectFunction(GetProcAddress(idapi32_handle, 'DbiOpenTable'), #LogHook_DbiOpenTable, #Actual_DbiOpenTable_CallStub, DbiOpenTable_address_plus_9, 9);
end;
end;
procedure UnPatchBDE;
begin
if idapi32_handle <> 0 then
begin
{Leave everything as before, just in case...}
if Patch_DbiOpenTable.OrgAddr <> nil then
RestorePatch(Patch_DbiOpenTable);
FreeLibrary(idapi32_handle);
idapi32_handle := 0;
end;
end;
initialization
idapi32_handle := 0;
TRYPatch_Clear(Patch_DbiOpenTable);
end.
VMWare, Virtual Box, etc to virtualize an Windows 7. If, as you say, W7 work flawlessly that would solve the problem.

Opening a Firebird database file on a network share

I thought converting a mapped drive letter to a UNC path would be enough to be able to open a .GDB file,
but alas:
function ConvertToUNCPath(AMappedDrive: string) : string;
var
lRemoteString : array[0..255] of char;
lpRemote : PChar;
lStringLen : Cardinal;
begin
lpRemote := #lRemoteString;
lStringLen := 255;
If WNetGetConnection(Pchar(ExtractFileDrive(AMappedDrive)) ,
lpRemote,
lStringLen) = NO_ERROR Then
Result := lRemoteString
else
Result := ''; // No mapping found
end;
function TDataModuleData.OpenGDBDatabase(AGDBName: string) : Boolean;
var
lDlgLogin: TFrmLogin;
p : Integer;
lUNC,
lErrMsg : String;
begin
Result := False;
with FDConnection do // TFDConnection
begin
Close;
TxOptions.Isolation := xiDirtyRead;
p := Pos(':',AGDBName);
if p = 2 then
begin
lUNC := ConvertToUNCPath(Copy(AGDBName,1,2));
if lUNC <> '' then
begin
lUNC := Copy(lUNC,3);
p := pos('\',lUNC);
AGDBName := Copy(lUNC,p) + Copy(AGDBName,3);
lUNC := copy(lUNC,1,p-1);
end;
end;
DriverName := S_FD_IBId;
Params.Database := AGDBName;
if lUNC <> '' then
Params.Add('Server=' + lUNC)
else
Params.Add('Server=localhost'); // Not strictly necessary
Params.UserName := 'SYSDBA';
Params.Password := 'masterkey';
try
Open;
Result := Connected;
except
on E:Exception do
begin
lErrMsg := LowerCase(E.Message);
end;
end;
end;
end;
Depending on how I parse the ConvertToUNCPath result I get different error messages:
[firedac][phys][ib]unavailable database
[firedac][phys][ib]i/o error during "createfile (open)" operation for file "persoonlijk\jan\klanten.gdb"'#$D#$A'error while trying to open file'#$D#$A'the system cannot find the path specified.
The part of the code using ConvertToUNCPath succesfully converts e.g. P:\Jan\KLANTEN.GDB to \\tt2012server\persoonlijk\Jan\KLANTEN.GDB.
How can I open a GDB file when the path points to a mapped drive letter?
Added: I tried these hardcoded variations, they all fail:
// lUNC := '\\2012server'; // Unable to complete network request to host
lUNC := 'tt2012server';
//AGDBName := '\\tt2012server\persoonlijk\jan\klanten.gdb';
//AGDBName := 'tt2012server\persoonlijk\jan\klanten.gdb';
//AGDBName := '\persoonlijk\jan\klanten.gdb';
//AGDBName := 'persoonlijk\jan\klanten.gdb';
//AGDBName := '\jan\klanten.gdb';
//AGDBName := 'jan\klanten.gdb';
//AGDBName := 'p:\jan\klanten.gdb'; (original input)
(P: maps to \\tt2012server\persoonlijk)
Added:
Sorry, I was not clear in my initial text: this is not about connecting to a database on a remote server per se. I just want my local 'DB inspection' tool to be able to open a GDB file if someone places it in my network share for inspection (instead of having to copy it to local disk first).
To only intention of using WNetGetConnection was to resolve drive letter to UNC path (some I code I found on the web).
1. Firebird explicitly denies attempts to open database files on non-local disks
Firebird is database server, and as such it focuses on performance and reliability.
http://www.firebirdfaq.org/faq46/
Performance means lots of data is cached, both cached for reading and cached for writing.
Reliability means Firebird has to gain worthy warrants from OS that:
a. no other process would tinker with the database file while the server has some data from it cached for reading.
b. at any moment in time the server might wish to write any data to the file from its cache and it is warranted that that data - at any moment in time - ends persistently written to the persistent media.
Network-connected disks nullify both warranties and consequently Firebird Server refuses to trust them.
You may hack Firebird configuration or source files on your own discretion to remove this safety check and open network-shared files, if you really need this more than safety and speed.
But proper solution would be installing Firebird server on the machine whose disks do carry the database file.
2. Connection String is not a database file name
AGDBName := '\\tt2012server\persoonlijk\jan\klanten.gdb'
This does NOT mean "local Firebird server should connect to tt2012server server using LOCAL_SYSTEM credentials and read the database file from persoonlijk shared resource", as you probably intended it to mean.
http://www.firebirdfaq.org/faq260/
If anything, Windows LOCAL_SYSTEM user is explicitly barred from most network operations to contain intruders and viruses. Even if you hack Firebird into opening network files, most probably Windows would prohibit this access anyway, unless you would setup your Windows to run Firebird Server service with some user account other than the default LOCAL_SYSTEM.
Anyway, what \\tt2012server\persoonlijk\jan\klanten.gdb Connection String actually means is that you request your application to connect to tt2012server using WNET (aka Microsoft Named Pipes) protocol and find Firebird server running on that server and communicating by WNET protocol, as opposed to TCP/IP protocol.
Judging by the error you quote - lUNC := '\\2012server'; // Unable to complete network request to host - the said tt2012server computer perhaps does not have a Firebird Server running and accepting Named Pipes connections.
The WNET protocol is considered obsoleted and would most probably be removed from the future Firebird Server versions. As of now it is working, but few people use it, thus little up to date experience exists in that area. It is suggested you would use TCP/IP protocol by default to connect your application to the Firebird Server running on the tt2012server machine, not WNET protocol.
PS. This question has duplicates:
Connecting to Firebird database from Windows local network
ibase_connect: remote computer host and shared db file from windows
PPS. Firebird is a multi-generation database engine.
Consequently, there is no "dirty read" transactions possible in Interbase/Yaffil/Firebird family.
TxOptions.Isolation := xiDirtyRead; - this line would not work. Most probably it would silently change the transaction class to "READ COMMITTED", less probably it would give an explicit error.

Client Application Name in DataSnap

I have client-server system that uses DataSnap. I want to log the client application data so I use the TDSServer - OnConnect Event. In this event I can access what I want with the following code:
IP:= DSConnectEventObject.ChannelInfo.ClientInfo.IpAddress
ClientPort:= DSConnectEventObject.ChannelInfo.ClientInfo.ClientPort
Protocol:= DSConnectEventObject.ChannelInfo.ClientInfo.Protocol
AppName:= DSConnectEventObject.ChannelInfo.ClientInfo.AppName
first 3 lines are OK but AppName is empty!!!
(I run server and client on the same computer i.e. localhost)
I have been unable to find any online information about how to specify the AppName when the client connects via TCP/IP. If you look at the code
procedure TDSTCPChannel.Open;
var
ClientInfo: TDBXClientInfo;
begin
inherited;
FreeAndNil(FChannelInfo);
FChannelInfo := TDBXSocketChannelInfo.Create(IntPtr(FContext.Connection), FContext.Connection.Socket.Binding.PeerIP);
ClientInfo := FChannelInfo.ClientInfo;
ClientInfo.IpAddress := FContext.Connection.Socket.Binding.PeerIP;
ClientInfo.ClientPort := IntToStr(FContext.Connection.Socket.Binding.PeerPort);
ClientInfo.Protocol := 'tcp/ip';
FChannelInfo.ClientInfo := ClientInfo;
end;
in DataSnap.DSTCPServerTransport.Pas it is evident that the ClientInfo.AppName is not set.
However, the following work-around works with the Seattle demo DataSnap Basic Server + Client:
In the client, add a Param 'AppName' to the SqlConnection1 component's Params and
set its value to something like 'MyTestApp'. Recompile the client.
Open the server in the IDE and modify the ServerContainerForm's code as shown below.
Code:
uses
[...], DBXTransport;
procedure TForm8.DSServer1Connect(DSConnectEventObject: TDSConnectEventObject);
var
S : String; // added
Info : TDBXClientInfo; // added
begin
ActiveConnections.Insert;
if DSConnectEventObject.ChannelInfo <> nil then
begin
ActiveConnections['ID'] := DSConnectEventObject.ChannelInfo.Id;
ActiveConnections['Info'] := DSConnectEventObject.ChannelInfo.Info;
end;
ActiveConnections['UserName'] := DSConnectEventObject.ConnectProperties[TDBXPropertyNames.UserName];
ActiveConnections['ServerConnection'] := DSConnectEventObject.ConnectProperties[TDBXPropertyNames.ServerConnection];
ActiveConnections.Post;
InsertEvent('Connect');
// following added to get AppName from client
S := DSConnectEventObject.ConnectProperties['AppName'];
Info := DSConnectEventObject.ChannelInfo.ClientInfo;
Info.AppName := S;
DSConnectEventObject.ChannelInfo.ClientInfo := Info;
Caption := DSConnectEventObject.ChannelInfo.ClientInfo.AppName;
end;
As you can see, it works by picking up the value set for AppName in the client's
SqlConnection1.Params in the call to `DSConnectEventObject.ConnectProperties['AppName']'
and then display it on the Caption of the ServerContainerForm.
Obviously, you could pass any other name/value pair by adding them to the SqlConnection's Params on the client and then pick them up on the server by calling DSConnectEventObject.ConnectProperties[].

displaySwitch.exe code replacement for windows (pre windows 7)

I'm writing an app I'd like to be backwardly compatible to some extent on XP, or at the very least windows vista.
EDIT FOR CLARITY: I need to be able to do what the first code snippet below does, but in XP. "Does anybody know the best approach to take under XP, given the functions aren't available in USER32.DLL.?"
My initial prototype code on windows 7 just called CreateProcess to start up displayswitch.exe, which is deployed with windows 7.
if you are not familiar with it, it's a handy little utility that is what gets invoked when you press the windows key and the letter P. you can read more about it here.
while this was adequate, i subsequently needed to sense the current state (eg internal vs external or extend vs clone), so i have now coded up a winapi solution that works well on windows 7 (and i presume 8). it involves making calls to SetDisplayConfig and QueryDisplayConfig in User32.DLL
The pertinent section of it is here (minus the many, many structures i had to hand craft in pascal code from the original klingon).
function getTopology : DISPLAYCONFIG_TOPOLOGY_ID ;
var NumPathArrayElements,
NumModeInfoArrayElements : UINT32;
var PathArrayElements_Size,
ModeInfoArrayElements_Size : UINT32;
error : Longint;
paths : PDISPLAYCONFIG_PATH_INFO_array;
info : PDISPLAYCONFIG_MODE_INFO_array;
begin
NumModeInfoArrayElements := 0;
Result := DISPLAYCONFIG_TOPOLOGY_EXTERNAL;
inc(result);
error := GetDisplayConfigBufferSizes(QDC_DATABASE_CURRENT,NumPathArrayElements,NumModeInfoArrayElements);
case error of
ERROR_SUCCESS :
begin
PathArrayElements_Size := sizeof(DISPLAYCONFIG_PATH_INFO) * NumPathArrayElements ;
ModeInfoArrayElements_Size := sizeof(DISPLAYCONFIG_MODE_INFO) * NumModeInfoArrayElements;
GetMem(paths,PathArrayElements_Size);
try
GetMem(info,ModeInfoArrayElements_Size );
try
error := QueryDisplayConfig(QDC_DATABASE_CURRENT,NumPathArrayElements, paths,NumModeInfoArrayElements, info,result);
case error of
ERROR_SUCCESS :;
else
Result := DISPLAYCONFIG_TOPOLOGY_EXTERNAL;
inc(result);
end;
finally
FreeMem(info,ModeInfoArrayElements_Size );
end;
finally
FreeMem(paths,PathArrayElements_Size);
end;
end;
end;
end;
function setTopology ( top : DISPLAYCONFIG_TOPOLOGY_ID) : boolean;
var flags : dword;
begin
result := false;
flags := DecodeDISPLAYCONFIG_TOPOLOGY_ID_SDC(top);
if flags <> 0 then
begin
result := SetDisplayConfig(0,nil,0,nil,SDC_APPLY or flags) = ERROR_SUCCESS;
end;
end;
Since these functions don't exist in XP (as far as I know), I am looking for a stable way of achieving a similar thing in XP. whilst i am coding in Delphi, it's not necessary that the solution be presented as such. i am quite happy to just look at how it's done, or read a description of the appropriate steps, and implement it myself.
(removed full listing as it was confusing the issue as it did not appear like a question)

Firebird Embedded & Delphi "unavailable database"

I'm using Firebird 2.5 (Embedded) And Delphi XE2.
I kept below files to my aplication root dir :
C:\myapp\app.exe
C:\myapp\fbclient.dll
C:\myapp\icudt30.dll
C:\myapp\icuin30.dll
C:\myapp\icuuc30.dll
C:\myapp\dbxfb.dll
And My Connection Settings :
procedure TMainForm.Button1Click(Sender: TObject);
var Con: TSQLConnection;
begin
Con := TSQLConnection.Create(Self);
With Con Do
Begin
Connected := False;
DriverName := 'FirebirdConnection';
Params.Clear;
Params.Add('DriverName=' + DriverName);
Params.Add('User_Name=SYSDBA');
Params.Add('Password=masterkey');
Params.Add('Database=C:\GHARARDAD.FDB');
Params.Add('SQLDialect=3');
LoginPrompt := False;
ConnectionName := 'Gharardad';
LibraryName := 'dbxfb.dll';
VendorLib := 'C:\fbclient.dll'; // Renamed fbembed.dll to fbclient.dll
GetDriverFunc := 'getSQLDriverInterBase';
Connected := True;
End;
End;
My Operation sys is : Win 7 64 bit
And FB embedde ver is : Firebird-2.5.1.26351-0_Win32_embed
And my app Compiled on 32 bit
DLL Sizes :
fbembed.dll -----> size 3,784,704 bytes
dbxfb.dll -----> size 288,768 bytes
But when i want to Run application, I get following Error:
DBX Error: Driver could not be properly. Client may be misiing, not
installed properly, of the wrong version, or thr driver may be misiing
from the system path.
What am I doing wrong?
You need specify Database parameter like this:
Params.Add('Database=C:\Full\Path\GHARARDAD.FDB');
I see you want to use embedded version, you need to use fbembed.dll insead of fbclient.dll
I don't know why you use ConnectionName if you allready specify database User_Name Password.
I would prefer something like this :
Con := TSQLConnection.Create(Self);
With Con Do
Begin
Connected := False;
DriverName := 'FirebirdConnection';
LibraryName := 'dbxfb.dll';
VendorLib := 'fbembed.dll';
ConnectionName := 'Gharardad';
Params.Value['User_Name'] := 'SYSDBA';
Params.Value['Password'] := 'masterkey';
Params.Value['Database'] := 'C:\GHARARDAD.FDB';
Connected := True;
End;
Do u have any other connections open to that database ?
FlameRobin, IBExpert, Delphi IDE Form Designer ?
Do you have any active datasets/connections in Delphi ?
Embedded requires non-shareable opening of file.
Run SysInternals Process Explorer and do search for your database file if it is already open by some another application
Do u really use weirdly renamed firebird embedded and not firebird client ?
#Marcodor and #Re0sless already asked you that.
It seems that you only think you're using embedded but u only have small share of server installed without main engine.
fbembed.dll 2.5.1 Win32 size is 3 784 704 bytes
fbclient.dll 2.5.1 Win64 size is 870 912 bytes
fbclient.dll 2.5.1 Win32 size is 548 864 bytes
Which is yours DLL ?
This can also be that database engine version and database file version do not match. Try SysInternals Process Monitor to see which files does your application try to find and open. Does it succesfully open the db files ? does it successfully find and open firebird.msg ? does it succesfully open icu*.dll ? maybe udf dlls ?
Is there some error written into firebird.log ?
In general - learn to use SysInternals Process Monitor to know what files and where were tried. It very frequently would hint you what error happened exactly and why.
You did not listed fbintl.dll
If your database containst non-Latin letters and non-English language, then it might be unable to open it without properly located fbintl. Check in Process Monitor where it is searched for and put there.
check in Process Monitor which firebird dll version your application actually loads. Is its version new enough to open that database ?
You said your using Firebird embedded but you are using the standard firebird VendorLib
VendorLib := 'fbclient.dll';
For embedded firebird this should be
VendorLib = '[pathtolib]\fbembed.dll'
You are also missing the value for GetDriverFunc
So the complete TSQLConnection object would looks like so (tested in Delphi 2007)
Con := TSQLConnection.Create(Self);
With Con Do
Begin
Connected := False;
DriverName := 'FirebirdConnection';
Params.Clear;
Params.Add('DriverName=' + DriverName);
Params.Add('User_Name=SYSDBA');
Params.Add('Password=masterkey');
Params.Add('Database=C:\GHARARDAD.FDB');
Params.Add('SQLDialect=3');
//other connection params here
ConnectionName := 'Gharardad';
LibraryName := 'dbxfb.dll';
VendorLib := 'C:\fbembed.dll';
GetDriverFunc = 'getSQLDriverInterBase' //Or what ever the dbxfb.dll function is called
Connected := True;
End;
End;
Note that the getSQLDriverInterBase function is the name of the function from the Devart firebird library so it may differ in the dbxfb.dll library.

Resources