I have a piece of code written in Delphi 2005 that searches for a particular attribute on a user in LDAP. I get an access violation when this is run on either Windows 7 or Server 2008, but not on XP or 2003.
Function IsSSOUser(UserId: String): Boolean;
var
S : string;
ADOQuery : TADOQuery;
ADOConnectionSSO: TADOConnection;
begin
result := false;
Setdomainname;
ADOQuery := TADOQuery.Create(nil);
ADOConnectionSSO := TADOConnection.Create(nil);
try
ADOConnectionSSO.LoginPrompt := false;
ADOConnectionSSO.Mode := cmRead;
ADOConnectionSSO.Provider := 'ADsDSOObject';
ADOQuery.Connection := ADOConnectionSSO;
ADOQuery.ConnectionString := 'Provider=ADsDSOObject;Encrypt Password=False;Mode=Read;Bind Flags=0;ADSI Flag=-2147483648';
ADOQuery.SQL.Clear;
try
S := 'SELECT AdsPath, CN, SN, SSOguid FROM '''
+ LDAPString + ''' WHERE objectClass=''user'' and CN = ''' + UserId + ''' ';
ADOQuery.SQL.Add(S);
ADOQuery.Open;
ADOQuery.ExecSQL;
if trim(ADOQuery.FieldByName('SSOguid').AsString) = '' then
result := false
else
result := true;
except
on e:Exception do
if e.ClassType <> EOleException then
Showmessage(format('[%s] Exception in IsSSOUser: [%s]',[e.ClassType.ClassName, e.Message]));
end;
finally
ADOQuery.Close;
ADOConnectionSSO.Close;
ADOQuery.free;
ADOConnectionSSO.free;
end;
end;
This code works fine on Windows XP and Windows Server 2003, but I get an access violation on both Windows 7 and Server 2008. I see a number of threads online about how changes to ADODB interface can break things on downstream OSes, but I am seemingly having the opposite problem. I'm building on a Windows 7 machine and the code only works on previous versions of Windows.
You will have to add
AdoQuery.ParamCheck := false;
before your
ADOQuery.SQL.Add(S);
since your LDAPString may contains a colon (:) eg. "LDAP://...." which causes the query to try create a parameter object for it. In addition there is no need for ADOQuery.ExecSQL after ADOQuery.Open.
Related
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;
I have a problem with taking MAC-addresses list in Windows XP from Inno Setup installer.
I'm trying to write some code (took it from Get MAC address in Inno Setup):
function GetMacAddressesList(out List: Array of String): Integer;
var
I: Integer;
WQLQuery: string;
WbemLocator: Variant;
WbemServices: Variant;
WbemObject: Variant;
WbemObjectSet: Variant;
begin
Result := 0;
WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
WbemServices := WbemLocator.ConnectServer('localhost', 'root\cimv2');
WQLQuery := 'Select * from Win32_NetworkAdapterConfiguration where IPEnabled=true';
WbemObjectSet := WbemServices.ExecQuery(WQLQuery);
if not VarIsNull(WbemObjectSet) and (WbemObjectSet.Count > 0) then
begin
Result := WbemObjectSet.Count;
SetArrayLength(List, WbemObjectSet.Count);
for I := 0 to WbemObjectSet.Count - 1 do
begin
WbemObject := WbemObjectSet.ItemIndex(I);
if not VarIsNull(WbemObject) then
begin
List[I] := WbemObject.MACAddress;
StringChange(List[i], ':', '');
StringChange(List[I], '-', '');
end;
end;
end;
end;
And I have a problem with ItemIndex method. It appears only in Windows Vista. How can I do this on XP? I really don't know, because every solution, that I have found in Internet doesn't work. May be because in Inno Setup libraries there is no such type as IEnumVariant and I can't iterate by SWbemObjectSet with for each obj in objset syntax...
I was also trying to get SWbemObject with Item method:
WbemObject := WbemObjectSet.Item('Win32_NetworkAdapterConfiguration.Index=' + IntToStr(I));
but it returns error
SWbemObjectSet: not found
Can anybody help me? Has this problem some solution?
Yes, you would have to implement the IEnumVariant. Not sure if that's possible with Pascal Script.
Use of the SWbemObjectSet.Item method is like this:
WbemLocator := CreateOleObject('WbemScripting.SWbemLocator');
WbemServices := WbemLocator.ConnectServer('localhost', 'root\cimv2');
WQLQuery := 'Select * from Win32_NetworkAdapterConfiguration';
WbemObjectSet := WbemServices.ExecQuery(WQLQuery);
if not VarIsNull(WbemObjectSet) then
begin
for I := 0 to WbemObjectSet.Count - 1 do
begin
WbemObject :=
WbemObjectSet.Item(Format('Win32_NetworkAdapterConfiguration=%d', [I]));
if WbemObject.IPEnabled then
begin
Log(WbemObject.MACAddress);
end;
end;
end;
But it seems that neither this approach works on Windows XP.
A possible workaround is to execute
wmic nicconfig get MACAddress
redirect to a file and read it.
See How to get an output of an Exec'ed program in Inno Setup?
With an TADOQuery.Locate that uses a list of fields and a VarArray of values, if one of the values contains a # sign, we get this exception:
'Arguments are of the wrong type, are out of acceptable range, or are in conflict with one another.'
I've traced this down to ADODB which itself seems to be using # signs as delimiters.
Is there a way to escape #-signs so that the query doesn't fail?
* EDIT 1 *
I was wrong. What causes this failure is a string that has a pound sign and a single quote. The code shown below fails with error message noted above.
What really worries us is that when it fails running as an .exe outside the IDE, there's no runtime exception. We only see the exception when we're in the IDE. If our programmers hadn't happened to be using data that triggers this we never would have known that the .Locate returned FALSE because of a runtime error, not because a matching record was not found.
Code:
var
SearchArray: Variant;
begin
SearchArray := VarArrayCreate([0,1], VarVariant);
SearchArray[0] := 'T#more''wo';
SearchArray[1] := 'One';
ADOQuery.Locate('FieldName1;FieldName2', SearchArray, []);
Please see Updates below; I've found a work-around that's at least worth testing.
Even with Sql Server tables, the # shouldn't need to be escaped.
The following code works correctly in D7..XE8
procedure TForm1.Button1Click(Sender: TObject);
begin
AdoQuery1.Locate('country;class', VarArrayOf(['GB', Edit1.Text]), []);
end;
when Edit1.Text contains 'D#E', so I think your problem must lie elsewhere. Try a minimalist project with just that code, after rebooting your machine.
Update: As noted in a comment, there is a problem with .Locate where the expression
passed to GetFilterStr (in ADODB.Pas) contains a # followed by a single quote. To try and
work out a work-around for this, I've transplanted GetFilterStr into my code and have
been experimenting with using it to construct a recordset filter on my AdoQuery, as I noticed
that this is what .Locate does in the statement
FLookupCursor.Filter := LocateFilter;
The code I'm using for this, including my "corrected" version of GetFilterStr, is below.
What I haven't managed to figure out yet is how to avoid getting an exception on
AdoQuery1.Recordset.Filter := S;
when the filter expression yields no records.
(Btw, for convenience, I'm doing this in D7, but using XE8's GetFilterStr, which is why I've had to comment out the reference to ftFixedWideChar)
function GetFilterStr(Field: TField; Value: Variant; Partial: Boolean = False): WideString;
// From XE8 Data.Win.ADODB
var
Operator,
FieldName,
QuoteCh: WideString;
begin
QuoteCh := '';
Operator := '=';
FieldName := Field.FieldName;
if Pos(' ', FieldName) > 0 then
FieldName := WideFormat('[%s]', [FieldName]);
if VarIsNull(Value) or VarIsClear(Value) then
Value := 'Null'
else
case Field.DataType of
ftDate, ftTime, ftDateTime:
QuoteCh := '#';
ftString, ftFixedChar, ftWideString://, ftFixedWideChar:
begin
if Partial and (Value <> '') then
begin
Value := Value + '*';
Operator := ' like '; { Do not localize }
end;
{.$define UseOriginal}
{$ifdef UseOriginal}
if Pos('''', Value) > 0 then
QuoteCh := '#' else
QuoteCh := '''';
{$else}
QuoteCh := '''';
if Pos('''', Value) > 0 then begin
QuoteCh := '';
Value := QuotedStr(Value);
end;
{$endif}
end;
end;
Result := WideFormat('(%s%s%s%s%2:s)', [FieldName, Operator, QuoteCh, VarToWideStr(Value)]);
end;
procedure TForm1.CreateFilterExpr;
var
S : String;
begin
// clear any existing filter
AdoQuery1.Recordset.Filter := adFilterNone;
AdoQuery1.Refresh;
if edFilter.Text = '' then Exit;
S := GetFilterStr(AdoQuery1.FieldByName('Applicant'), edFilter.Text, cbPartialKey.Checked);
// Add the filter expr to Memo1 so we can inspect it
Memo1.Lines.Add(S);
try
AdoQuery1.Recordset.Filter := S;
AdoQuery1.Refresh;
except
end;
end;
procedure TForm1.FilterClick(Sender: TObject);
begin
CreateFilterExpr;
end;
Update 2: Try the following:
Copy Data.Win.ADODB.Pas to your project directory
In it, replace GetFilterExpr by the version above, making sure that UseOriginal
isn't DEFINEd, and that ftFixedWideChar is reinstated in the Case statement.
Build and run your project
In XE8 at any rate, my testbed now correctly Locate()s a field ending with ' or #'
(or containing either of them if loPartialKey is specified. (I can't test in XE4/5
because my XE4 now says it's unlicenced since I upgraded to Win10 last week, thanks EMBA!)
I hestitate to call this a solution or even a work-around as yet, but it is at least worth testing.
I'm not sure whether I'd call the original version of GetFilterExpr bugged, because I'm not sure
what use-case its treatment of values containing quotes was intended to handle.
I have built the worlds dumbest and most simple SOAP server, in about 3 clicks, in visual studio. The exact steps in visual studio 2010: First create a new project as a web application, Then add a new item of type web service. (See accepted answer here for picture.) That soap server service Service1 has a simple method GetData:
A snippet from clientService1.pas, created using WSDL importer...
IService1 = interface(IInvokable)
['{967498E8-4F67-AAA5-A38F-F74D8C7E346A}']
function GetData(const value: Integer): string; stdcall;
function GetDataUsingDataContract(const composite: CompositeType2): CompositeType2; stdcall;
end;
When I try to run this method, like this:
procedure TForm3.Button1Click(Sender: TObject);
var
rio : THTTPRIO;
sv:IService1;
addr : string;
data : string;
begin
//addr := '....'; // url from visual studio 2010 live debug instance.
rio := THTTPRIO.Create(nil);
sv := GetIService1( true, addr, rio );
try
data := sv.GetData( 0);
Button1.Caption := data;
finally
sv := nil;
rio.Free;
end;
end;
The error I get is this:
ESOAPHTTPException:
The handle is in the wrong state for the requested operation -
URL:http://localhost:8732/Design_Time_Addresses/WcfServiceLibrary1/Service1/ -
SOAPAction:http://tempuri.org/IService1/GetData'.
The URL works fine when I paste the url above into a web browser, so the usual answer that the SOAP code in Delphi has the tendency to not notice an HTTP failure, does not seem likely. Rather it seems that I am either (a) experiencing breakage in WinInet (known to happen in some versions of windows), or (b) doing something wrong?
It seems to me that anybody who has visual studio and delphi both installed, should be able to try to get the dummy starter Soap server in Visual Studio talking to the soap client in Delphi, without any effort at all. But I can not figure out the simplest things.
At one time there was a discussion about the error in a conversation now long since deleted from Embarcadero forums, by Bruneau Babet, an embarcadero staffer.
Bruno said:
Hello,
I've posted a patched version of SOAPHTTPTrans.pas that contains a fix
for this issue here:
[forum link redacted, it didn't work anymore anyways, the post is gone]
You may still override the event as described in the C++Builder
section referred; or, much simpler, at least for Delphi users, simply
add the updated SOAPHTTPTrans.pas to your app's project. Let us know
if that does not work for you.
Cheers,
Bruneau
You can get the repair and the notes about it in its original forum formatting from the following pastebin link and on bitbucket so you don't have to extract the file from the surrounding text.
Warren Update 2016: I have been informed by someone who tried to use the fix on Delphi XE that this fix does NOT work for them in Delphi XE. Any further updates to the code in bitbucket that resolve the remaining bugs would be appreciated.
I ran into the The handle is in the wrong state for the requested operation issue in November 2018 using Delphi Tokyo 10.2.3, then looked at the code patch in the pastebin link under Arjen's answer.
That code is very old and the test code no longer works (SOAP service unavailable). Also, it is unclear from Bruneau's code what he patched exactly.
Comparing that source and the one from my Delphi version it seems that these are the (two) required modifications in the HandleWinInetError procedure ('PATCH HERE'):
function THTTPReqResp.HandleWinInetError(LastError: DWord;
Request: HINTERNET;
RaiseError: Boolean): DWord;
function CallInternetErrorDlg: DWord;
var
P: Pointer;
begin
Result := InternetErrorDlg(GetDesktopWindow(), Request, LastError,
FLAGS_ERROR_UI_FILTER_FOR_ERRORS or
FLAGS_ERROR_UI_FLAGS_CHANGE_OPTIONS or
FLAGS_ERROR_UI_FLAGS_GENERATE_DATA, P);
{ After selecting client certificate send request again,
Note: InternetErrorDlg always returns ERROR_SUCCESS when called with
ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED }
if LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED then
Result := ERROR_INTERNET_FORCE_RETRY;
end;
const
{ Missing from our WinInet currently }
INTERNET_OPTION_CLIENT_CERT_CONTEXT = 84;
var
Flags, FlagsLen, DWCert, DWCertLen: DWord;
ClientCertInfo: IClientCertInfo;
CertSerialNum: string;
{$IFDEF CLIENT_CERTIFICATE_SUPPORT}
hStore: HCERTSTORE;
CertContext: PCERT_CONTEXT;
{$ENDIF}
begin
{ Dispatch to custom handler, if there's one }
if Assigned(FOnWinInetError) then
Result := FOnWinInetError(LastError, Request)
else
begin
Result := ERROR_INTERNET_FORCE_RETRY;
{ Handle INVALID_CA discreetly }
if (LastError = ERROR_INTERNET_INVALID_CA) and (soIgnoreInvalidCerts in InvokeOptions) then
begin
FlagsLen := SizeOf(Flags);
InternetQueryOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(#Flags), FlagsLen);
Flags := Flags or SECURITY_FLAG_IGNORE_UNKNOWN_CA;
InternetSetOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(#Flags), FlagsLen);
end
else if (LastError = ERROR_INTERNET_SEC_CERT_REV_FAILED) and (soIgnoreInvalidCerts in InvokeOptions) then
begin
FlagsLen := SizeOf(Flags);
InternetQueryOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(#Flags), FlagsLen);
Flags := Flags or SECURITY_FLAG_IGNORE_REVOCATION;
InternetSetOption(Request, INTERNET_OPTION_SECURITY_FLAGS, Pointer(#Flags), FlagsLen);
end
{$IFDEF CLIENT_CERTIFICATE_SUPPORT}
else if (LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED) and
Supports(Self, IClientCertInfo, ClientCertInfo) and
(ClientCertInfo.GetCertSerialNumber <> '') then
begin
CertSerialNum := ClientCertInfo.GetCertSerialNumber();
hStore := ClientCertInfo.GetCertStore();
if hStore = nil then
begin
hStore := CertOpenSystemStore(0, PChar('MY'));
ClientCertInfo.SetCertStore(hStore);
end;
CertContext := FindCertWithSerialNumber(hStore, CertSerialNum);
if CertContext <> nil then
begin
ClientCertInfo.SetCertContext(CertContext);
InternetSetOption(Request, INTERNET_OPTION_CLIENT_CERT_CONTEXT,
CertContext, SizeOf(CERT_CONTEXT));
end
else
begin
if RaiseError then RaiseCheck(LastError); // PATCH HERE
Result := CallInternetErrorDlg;
end;
end
{$ENDIF}
else if (LastError = ERROR_INTERNET_CLIENT_AUTH_CERT_NEEDED) and (soPickFirstClientCertificate in InvokeOptions) then
begin
{ This instructs WinInet to pick the first (a random?) client cerficate }
DWCertLen := SizeOf(DWCert);
DWCert := 0;
InternetSetOption(Request, INTERNET_OPTION_SECURITY_SELECT_CLIENT_CERT,
Pointer(#DWCert), DWCertLen);
end
else
begin
if RaiseError then RaiseCheck(LastError); // PATCH HERE
Result := CallInternetErrorDlg;
end;
end;
end;
Note that the RaiseError procedure parameter was not even used before this patch ;-)
Here is some test code using the SOAP service from NOAA's National Digital Forecast Database (NDFD) SOAP Web Service:
Uses SOAP.SOAPHTTPTrans;
const Request2 =
'<soapenv:Envelope xmlns:xsi="http://www.w3.org/2001/XMLSchema-instance" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:soapenv="http://schemas.xmlsoap.org/soap/envelope/" xmlns:ndf="http://graphical.weather.gov/xml/DWMLgen/wsdl/ndfdXML.wsdl">' +
' <soapenv:Header/>' +
' <soapenv:Body>' +
' <ndf:NDFDgenByDay soapenv:encodingStyle="http://schemas.xmlsoap.org/soap/encoding/">' +
' <latitude xsi:type="xsd:decimal">38.9936</latitude>' +
' <longitude xsi:type="xsd:decimal">-77.0224</longitude>' +
' <startDate xsi:type="xsd:date">%tomorrow%</startDate>' +
' <numDays xsi:type="xsd:integer">5</numDays>' +
' <Unit xsi:type="dwml:unitType" xmlns:dwml="http://graphical.weather.gov/xml/DWMLgen/schema/DWML.xsd">e</Unit>' +
' <format xsi:type="dwml:formatType" xmlns:dwml="http://graphical.weather.gov/xml/DWMLgen/schema/DWML.xsd">12 hourly</format>' +
' </ndf:NDFDgenByDay>' +
' </soapenv:Body>' +
'</soapenv:Envelope>';
const URL2= 'https://graphical.weather.gov:443/xml/SOAP_server/ndfdXMLserver.php';
procedure TFrmHandleWinINetError.Button1Click(Sender: TObject);
var
RR: THTTPReqResp;
Response: TMemoryStream;
U8: UTF8String;
begin
RR := THTTPReqResp.Create(nil);
try
try
RR.URL := URL2;
RR.UseUTF8InHeader := True;
RR.SoapAction := 'NDFDgenByDay';
Response := TMemoryStream.Create;
RR.Execute(Request2, Response);
SetLength(U8, Response.Size);
Response.Position := 0;
Response.Read(U8[1], Length(U8));
ShowMessage(String(U8));
except
on E:Exception do ShowMessage('ERROR CAUGHT: ' + e.message);
end;
finally
Response.Free;
RR.Free;
end;
end;
end;
Without the patch errors in the tail end of the URL are caught, but errors in the domain name just trigger an empty error message.
With the patch those are also caught.
I have a reported the issue in the RAD Studio Quality Portal under number RSP-21862
Use at your own risk and please report any additional findings.
Addition: The issue was fixed in Dec 2018 in Delphi 10.3 Rio and the Quality Portal issue was closed with the following remark:
In RAD Studio 10.3 the implementation of THTTPReqResp was changed and replaced with THTTPClient. So, this issue no longer applies.
I have not verified this.
The below code works in Delphi 2007, but it gives me this error in Delphi 2010:
---------------------------
Error
---------------------------
Cannot load oci.dll library (error code 127).
The oci.dll library may be missing from the system path
or you may have an incompatible version of the
library installed.
---------------------------
OK Details >>
---------------------------
The exception is raised when I set "connected" to "true".
I have tried placing a copy of "oci.dll" in the same folder as the .exe file, but I get the same message.
I also get this message when using the form designer and a visible TSQLConnection component.
Any thoughts?
function TDBExpressConnector.GetConnection(username, password, servername: string) : TSQLConnection;
begin
//take a username, password, and server
//return a connected TSQLConnection
try
FSqlDB := TSQLConnection.Create(nil);
with FSqlDB do begin
Connected := False;
DriverName := 'Oracle';
GetDriverFunc := 'getSQLDriverORACLE';
KeepConnection := True;
LibraryName := 'dbxora30.dll';
ConnectionName := 'OracleConnection';;
Params.Clear;
Params.Add('DriverName=Oracle');
Params.Add('DataBase=' + servername);
Params.Add('User_Name=' + username);
Params.Add('Password=' + password);
Params.Add('RowsetSize=20');
Params.Add('BlobSize=-1');
Params.Add('ErrorResourceFile=');
Params.Add('LocaleCode=0000');
Params.Add('Oracle TransIsolation=ReadCommited');
Params.Add('OS Authentication=False');
Params.Add('Multiple Transaction=False');
Params.Add('Trim Char=False');
Params.Add('Decimal Separator=.');
LoginPrompt := False;
Connected := True;
end;
Result := FSqlDB;
except on e:Exception do
raise;
end; //try-except
end;
In Delphi 2010 the dbExpress driver for Oracle is dbxora.dll. The libraryname in your named connection says dbxora30.dll. Good chance it will work with the correct name!
See the problem and the fix here: My Blog
Just substitute your dll for the one I mention in my post. You should find it in the same directory.