With the nslookup command (on Windows) or the host command on Linux, a computer can query the DNS for a LDAP server (see https://serverfault.com/questions/153526/how-can-i-find-the-ldap-server-in-the-dns-on-windows).
Is it possible to do these queries with the Indy DNS resolver component?
nslookup -type=srv _ldap._tcp.DOMAINNAME
or
host -t srv _ldap._tcp.DOMAINNAME
Easy :
program SO18309621;
{$APPTYPE CONSOLE}
uses
IdDNSResolver,
SysUtils;
var
Dns : TIdDNSResolver;
Rec : TResultRecord;
Srv : TSRVRecord;
Index : Integer;
begin
try
Dns := TIdDNSResolver.Create;
try
Dns.Host := 'mydnsserver.mydomain';
Dns.QueryType := [qtService];
Dns.Resolve('_ldap._tcp.mydomain');
for Index := 0 to Dns.QueryResult.Count - 1 do
begin
Rec := Dns.QueryResult[Index];
if Rec is TSRVRecord then
begin
Srv := TSRVRecord(Rec);
Writeln('Target=', Srv.Target, ', Port=', Srv.Port, ', Priority=', Srv.Priority, ', Weight=', Srv.Weight);
end;
end;
finally
Dns.Free;
end;
except
on E: Exception do
Writeln(E.ClassName, ': ', E.Message);
end;
end.
Related
I have to communicate with a government API. This API requires a digital certificate to make requests.
If I make the request using the Indy components (TIdHTTP and TIdSSLIOHandlerSocketOpenSSL), I get the following exception:
"EIdOSSLUnderlyingCryptoError with message: error:14094412:SSL routines:SSL3_READ_BYTES:sslv3 alert bad certificate".
If I make the request using a THTTPRIO or THTTPReqResp component, no exception occurs and I am able to get the response from the request.
Why does the problem only occur with Indy? And what would be a possible solution?
I'm making the Indy request as follows:
procedure TFrmApp.btnIndyClick(Sender: TObject);
var
Response: TStringStream;
Url: string;
begin
Response := TStringStream.Create('', TEncoding.UTF8);
Url := 'https://testes.tcm.go.gov.br:8443/passaporte/api/auth/representacoes';
try
try
// HTTPIndy is TIdHTTP
// OpenSSLIndy is TIdSSLIOHandlerSocketOpenSSL
HTTPIndy.IOHandler := OpenSSLIndy;
OpenSSLIndy.SSLOptions.CertFile := 'cert.pem';
OpenSSLIndy.SSLOptions.RootCertFile := 'cert_nokeys.pem';
OpenSSLIndy.SSLOptions.KeyFile := 'server.key';
HTTPIndy.Get(Url, Response);
{ Response handling... }
except
on E: Exception do
MessageDlg('Error: ' + sLineBreak + sLineBreak + E.message, mtError, [mbOK], 0);
end;
finally
Response.Free;
end;
end;
The .PEM and .KEY files were generated from .PFX using OpenSSL (1.1.1d), using the following commands:
openssl pkcs12 -in "MyCert.pfx" -passin pass:MyPass -out "cert.pem" -nodes
openssl pkcs12 -in "MyCert.pfx" -passin pass:MyPass -out "cert_nokeys.pem" -clcerts -nokeys
openssl pkcs12 -in "MyCert.pfx" -passin pass:MyPass -out "key.pem" -passout pass:MyPass -nocerts
openssl rsa -in "key.pem" -passin pass:MyPass -out "server.key"
The request using HTTPRIO, I'm doing as follows:
procedure TFrmApp.btnRIOClick(Sender: TObject);
var
Response: TStringStream;
Url: string;
begin
Response := TStringStream.Create('', TEncoding.UTF8);
Url := 'https://testes.tcm.go.gov.br:8443/passaporte/api/auth/representacoes';
try
try
// HTTPRIO is THTTPRIO
HTTPRIO.URL := Url;
HTTPRIO.HTTPWebNode.Get(Response);
{ Response handling ... }
except
on E: Exception do
MessageDlg('Error: ' + sLineBreak + sLineBreak + E.message, mtError, [mbOK], 0);
end;
finally
Response.Free;
end;
end;
I can't remove all the windows 10 firewall rules there are always left some rules that can't be removed and I don't know why. How can I remove all the windows 10 firewall rules?
I'm running the application as administrator
First, I get a list of all the firewall rules and store in a list: listaReglas
then I make a loop on that list and call a function to remove the rule like this
listaReglas:=TlistaReglas.Create;
ListarReglasdelFireWall(listaReglas);
for i:=0 to listaReglas.TotalReglas-1 do begin
unaRegla:= listaReglas.GetUnaRegla(i);
if DELUnaRegla(unaRegla.name, error) then begin
memo1.Lines.Add(IntToStr(i) + ' '+unaRegla.name +' removed OK')
end else begin
memo1.Lines.Add(IntToStr(i) + ' '+unaRegla.name +' ERROR removing')
end;
end;
listaReglas.Free;
The function DELUnaRegla()
function DELUnaRegla(NombreRegla:String;var ERROR:String):boolean;
var
fwPolicy2 : OleVariant;
vExisteError:Boolean;
begin
vExisteError:=False;
try
CoInitialize(nil);
try
fwPolicy2 := CreateOleObject('HNetCfg.FwPolicy2');
fwPolicy2.Rules.Remove(NombreRegla);
finally
CoUninitialize;
end;
except
on E:EOleException do begin
Error:=Format('EOleException %s %x', [E.Message,E.ErrorCode]);
vExisteError:=true;
end;
on E:Exception do begin
Error:=E.Classname + ':' + E.Message;
vExisteError:=true;
end;
end;
result:=not(vExisteError);
end;
Here's a batch script that will delete all of the rules. - Resetting to default clears the rules that do not delete correctly.
#echo off
echo - Resetting To Default
netsh advfirewall reset >nul 2>&1
echo - Deleting Rules (In)
netsh advfirewall firewall show rule name=all dir=in | find /i "Rule Name:" > "%tmp%\1.txt"
for /f "tokens=3*" %%A in ('type "%tmp%\1.txt"') do (
netsh advfirewall firewall delete rule Name="%%A %%B" >nul 2>&1)
echo - Deleting Rules (Out)
netsh advfirewall firewall show rule name=all dir=out | find /i "Rule Name:" > "%tmp%\1.txt"
for /f "tokens=3*" %%A in ('type "%tmp%\1.txt"') do (
netsh advfirewall firewall delete rule Name="%%A %%B" >nul 2>&1)
I'm trying to upload the file using the library THTTPSendEx.
My code:
procedure TForm1.Button1Click(Sender: TObject);
var
HTTP:THTTPSendEx;
Data:TMultipartFormDataStream;
sHTML:string; //Recived HTML code from web
begin
if OpenDialog1.Execute then
begin
HTTP:=THTTPSEndEx.Create;
Data:=TMultipartFormDataStream.Create;
try
Data.AddFile('myFile', OpenDialog1.FileName);
Data.DataEnd;
if HTTP.Post('http://kaon.rghost.ru/files',Data,sHTML) then
begin
//Connection established
//Check HTTP response
if HTTP.IsSuccessfull then //HTTP returns "200 OK" code.
begin
ShowMessage('File successfully posted to the server.');
end;
end else
begin
ShowMessage('Can not establish a connection to the server...'+#13+'Network is not avaliable or server socket does not exist.');
end;
finally
FreeAndNil(HTTP);
FreeAndNil(Data);
end;
end;
end;
But nothing prints. Prompt in what a problem?
I'm sorry for the bad translation, I used Google Translater
UPDATE:
Working example for php:
$ url = 'http://kaon.rghost.ru/files';
$ FILENAME = 'add.png';
$ files = array ('file' => '#'. $ FILENAME);
$ useragent = 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv: 1.9.0.3) Gecko/2008092417 Firefox/3.0.3';
$ ch = curl_init ($ url);
curl_setopt ($ ch, CURLOPT_HTTPHEADER, array ("Content-type: multipart / form-data"));
curl_setopt ($ ch, CURLOPT_HEADER, 1);
curl_setopt ($ ch, CURLOPT_RETURNTRANSFER, 1);
curl_setopt ($ ch, CURLOPT_USERAGENT, $ useragent);
curl_setopt ($ ch, CURLOPT_POSTFIELDS, $ files);
$ response = curl_exec ($ ch);
echo $ response;
For file posting, ANY web-site requires cookies and/or post params and/or valid input field name for file. That's minimum what need to post the file to the server.
You just copy example, paste yours url and load file to stream. Nope this didn't works that.
I don't see anything of required by rghost.ru for file posting in your code.
We need to execute ffmpeg in a command window in my delphi application.
We found the solution to protect the path with the function "ExtractShortPathName".
But on some computers we can't get the 8.3 path (HKLM\SYSTEM\CurrentControlSet\Control\FileSystem\NtfsDisable8dot3NameCreation is 2) and we want to find another way to escape the spaces.
Here is the code :
sParameters := '"C:\Users\[...]\input.wav" -r 12.03 -f image2 -i "C:\Users\[...]\delphilm%d.png" -vf "scale=1024:704" -ab 96k -r 24 -b 2000k -pass 1 -vcodec libx264 -fpre "C:\[...]\libx264-normal.ffpreset" "C:\Users\[...]\export.mp4"';
sCommand := 'C:\Program Files\My application\utils\bin\ffmpeg.exe';
Handle := CreateProcess(nil, PChar('cmd.exe /C '+ProtectPath(sCommand)+' '+sParameters),nil, nil, True, 0, nil, nil, SI, PI);
With the ProtectPath function :
function ProtectPath(sCommand:Widestring):Widestring;
begin
Result := sCommand;
// get the 8.3 path
Result := ExtractShortPathName(sCommand);
// if 8.3 path is not accessible
if(Pos(' ', Result)>0)then begin
//Result := '"'+sCommand+'"'; --> do not work
//Result := StrReplace(sCommand, ' ','" "'); --> do not work
//Result := StrReplace(sCommand, ' ','^ '); --> do not work
//Result := StrReplace(sCommand, ' ','\ '); --> do not work
//Result := StrReplace(sCommand, ' ','\\ '); --> do not work
//Result := StrReplace(sCommand, ' ','/ '); --> do not work
//Result := StrReplace(sCommand, ' ','// '); --> do not work
end;
end;
Any ideas ?
You do not need to retrieve the 8.3 filename. All you have to do is wrap a long path with a single pair of quotation marks if it contains any space characters in it (like you are already doing with some of your FFMPEG parameters). Then, get rid of cmd.exe altogether and just call ffmpeg.exe directly instead.
sCommand := '"C:\Program Files\My application\utils\bin\ffmpeg.exe"';
sParameters := '"C:\Users\[...]\input.wav" -r 12.03 -f image2 -i "C:\Users\[...]\delphilm%d.png" -vf "scale=1024:704" -ab 96k -r 24 -b 2000k -pass 1 -vcodec libx264 -fpre "C:\[...]\libx264-normal.ffpreset" "C:\Users\[...]\export.mp4"';
Handle := CreateProcess(nil, PChar(sCommand + ' ' + sParameters), nil, nil, True, 0, nil, nil, SI, PI);
If you want to do the quoting dynamically, use (Ansi)QuotedStr() for that, eg:
function ProtectParam(sParam: String): String;
begin
if LastDelimiter(' "', sParam) <> 0 then
Result := QuotedStr(sParam)
else
Result := sParam;
end;
FFMPEG := 'C:\Program Files\My application\utils\bin\ffmpeg.exe';
InputFile := 'C:\Users\[...]\input.wav';
PngFile := 'C:\Users\[...]\delphilm%d.png';
PresetFile := 'C:\[...]\libx264-normal.ffpreset';
ExportFile := 'C:\Users\[...]\export.mp4';
sCommand := ProtectParam(FFMPEG) + ' ' + ProtectParam(InputFile) + ' -r 12.03 -f image2 -i ' + ProtectParam(PngFile) + ' -vf "scale=1024:704" -ab 96k -r 24 -b 2000k -pass 1 -vcodec libx264 -fpre ' + ProtectParam(PresetFile) + ' ' + ProtectParam(ExportFile);
Handle := CreateProcess(nil, PChar(sCommand), nil, nil, True, 0, nil, nil, SI, PI);
I don't see any real reason to use cmd.exe here. It's just adding an extra layer of complexity that burns you. You are asking cmd.exe to call CreateProcess to start ffmpeg, so why not do it directly?
That said, a cheap and cheerful way to side-step the problem is to make use of the working directory. Pass 'C:\Program Files\My application\utils\bin' for the working directory of the new process, and then PChar('cmd.exe /C ffmpeg.exe '+sParameters) is all you need.
I need to launch MS Window's OpenFiles.exe from a Delphi XE2 application to export currently opened files to a text file. The normal cmd.exe syntax is something like:
Openfiles.exe /query /s 127.0.0.1 /nh >c:\OpenFilesExport.txt
Using the following code returns a successful exit code but the export file is not generated:
var
exInfo: TShellExecuteInfo;
exitcode: DWORD;
begin
FillChar(exInfo, Sizeof(exInfo), 0);
with exInfo do
begin
cbSize := Sizeof(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
lpVerb := 'open';
lpFile := Pchar('Openfiles.exe');
lpParameters := PChar('/query /s 127.0.0.1 /nh >c:\OpenFilesOutput.txt');
nShow := SW_SHOWNORMAL
end;
if ShellExecuteEx(#exInfo) then
begin
while GetExitCodeProcess(exInfo.hProcess, exitcode)
and (exitcode = STILL_ACTIVE) do
Application.ProcessMessages();
CloseHandle(exInfo.hProcess);
end
else
ShowMessage(SysErrorMessage(GetLastError));
I've also tried putting the cmd.exe syntax in a bat file and launching that from shellexecute and it DOES generate the file but there is no content. Running the same bat file from explorer generates the file as expected.
How can I launch Openfiles.exe successfully from ShellExecute?
Your problem is the redirect, >, which only makes sense if you have a command interpreter. And in your code you do not. You have two options:
Call ShellExecuteEx passing a command interpreter to do the work.
Use CreateProcess to execute the other process, but pass a handle to a file as the stdout handle for the new process.
For the command interpreter option you would have a command line like this:
cmd /c Openfiles.exe /query /s 127.0.0.1 /nh >c:\OpenFilesExport.txt
The code might be like so:
FillChar(exInfo, Sizeof(exInfo), 0);
with exInfo do
begin
cbSize := Sizeof(exInfo);
fMask := SEE_MASK_NOCLOSEPROCESS or SEE_MASK_FLAG_DDEWAIT;
lpFile := 'cmd.exe';
lpParameters := '/c Openfiles.exe /query /s 127.0.0.1 /nh >c:\OpenFilesExport.txt';
nShow := SW_SHOWNORMAL;
end;
For the CreateProcess option you'll need to create the file with a call to CreateFile, and pass that handle as stdout of the new process. You'll need to make sure that the file handle is inheritable. And finally you'll need to wait on the process so that you can close the file handle.
Regarding your current code, your wait is not very pleasant. It's a busy wait that needlessly consumes CPU. You should use a blocking wait on the process handle.