I'm using google distancematrix to calculate travel expenses for emplyees. This all worked fine a while ago, and for several clients running it on location also.
Now I'm researching a bug (that really has nothing to do with this API), and when I make the API call from my debugging environment, I get:
"HttpSendRequest Error 12157: an error occurred in the secure channel support"
When I make the same request from a browser, it all works fine and I get the XML-file I'm requesting.
This is strictly local issue; at the client site the distances are calculated just fine.
Here's the code I use:
function Https_Get(const ServerName,Resource : string;Var Response:AnsiString): Integer;
const
BufferSize=1024*64;
var
hInet : HINTERNET;
hConnect : HINTERNET;
hRequest : HINTERNET;
ErrorCode : Integer;
lpvBuffer : PAnsiChar;
lpdwBufferLength: DWORD;
lpdwReserved : DWORD;
dwBytesRead : DWORD;
lpdwNumberOfBytesAvailable: DWORD;
begin
Result :=0;
Response:='';
hConnect := InternetConnect(hInet, PChar(ServerName), INTERNET_DEFAULT_HTTPS_PORT, nil, nil, INTERNET_SERVICE_HTTP, 0, 0);
if hConnect=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('InternetConnect Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
//make the request
hRequest := HttpOpenRequest(hConnect, 'GET', PChar(Resource), HTTP_VERSION, '', nil, INTERNET_FLAG_SECURE, 0);
if hRequest=nil then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpOpenRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
try
//send the GET request
if not HttpSendRequest(hRequest, nil, 0, nil, 0) then
begin
ErrorCode:=GetLastError;
raise Exception.Create(Format('HttpSendRequest Error %d Description %s',[ErrorCode,GetWinInetError(ErrorCode)]));
end;
Coded elsewhere:
sServer = 'maps.googleapis.com';
sParams = '/maps/api/distancematrix/xml?origins=%s+NL&destinations=%s+NL&sensor=false';
...
ResponseCode:=Https_Get(sServer,Format(sParams,[PostcodeVan, PostcodeNaar]), Response);
PostcodeVan and PostcodeNaar are the two ZIP codes and properly filled. Code cancels at the HttpSendRequest statement.
Anyone got any ideas? Especially the fact that it the (server+resource) link in a browser works fine dazzles me!
Thanks in advance!
Related
I would like to make a terminal with a Lazarus GUI application. But I'm in trouble. And I hope someone can help me, please.
Question1: The Chinese and other special chars cannot display normally, I would like to know how to fix this problem.
(code)Class of the thread and "run" button on click event
screenshot
Question2: I want to know how to input some command into the console. I tried to start a Windows cmd, and use "winver" command. But when I click the button, nothing happened.
The send command button
Winver is not console but a GUI program. To run a program with output into memo, use the following code, which retrieves version using the cmd.exe "ver" command. You can try to use this template for the first question too.
unit mainprocesstomemo;
{$mode delphi}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, Process, Pipes;
Type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Memo1: TMemo;
procedure Button1Click(Sender: TObject);
private
public
procedure ProcessEvent(Sender,Context : TObject;Status:TRunCommandEventCode;const Message:string);
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
{ TProcessMemo }
Type
TProcessToMemo = class(TProcess)
public
fmemo : Tmemo;
bytesprocessed : integer;
fstringsadded : integer;
function ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean;override;
end;
function RunCommandMemo(const exename:TProcessString;const commands:array of TProcessString;out outputstring:string; Options : TProcessOptions = [];SWOptions:TShowWindowOptions=swoNone;memo:TMemo=nil;runrefresh : TOnRunCommandEvent=nil ):boolean;
Var
p : TProcessToMemo;
i,
exitstatus : integer;
ErrorString : String;
begin
p:=TProcessToMemo.create(nil);
if Options<>[] then
P.Options:=Options - [poRunSuspended,poWaitOnExit];
p.options:=p.options+[poRunIdle];
P.ShowWindow:=SwOptions;
p.Executable:=exename;
if high(commands)>=0 then
for i:=low(commands) to high(commands) do
p.Parameters.add(commands[i]);
p.fmemo:=memo;
p.OnRunCommandEvent:=runrefresh;
try
result:=p.RunCommandLoop(outputstring,errorstring,exitstatus)=0;
finally
p.free;
end;
if exitstatus<>0 then result:=false;
end;
{ TForm1 }
procedure TForm1.Button1Click(Sender: TObject);
var s : string;
begin
//RunCommandMemo('testit',[],s,[],swonone,memo1,ProcessEvent);
RunCommandMemo('cmd.exe',['/w','/c','ver'],s,[],swonone,memo1,ProcessEvent);
end;
procedure TForm1.ProcessEvent(Sender, Context: TObject;
Status: TRunCommandEventCode; const Message: string);
begin
if status in [RunCommandIdle, RunCommandFinished] then
begin
if status =RunCommandFinished then
begin
memo1.lines.add(' process finished');
end;
if tprocesstomemo(sender).fstringsadded>0 then
begin
tprocesstomemo(sender).fstringsadded:=0;
// memo1.lines.add('Handle:'+inttostr(tprocesstomemo(sender).ProcessHandle));
memo1.refresh;
end;
sleep(10);
application.ProcessMessages;
end;
end;
{ TProcessToMemo }
function TProcessToMemo.ReadInputStream(p:TInputPipeStream;var BytesRead:integer;var DataLength:integer;var Data:string;MaxLoops:integer=10):boolean;
var lfpos : integer;
crcorrectedpos:integer;
stradded : integer;
newstr : string;
begin
Result:=inherited ReadInputStream(p, BytesRead, DataLength, data, MaxLoops);
if (result) and (bytesread>bytesprocessed)then
begin
stradded:=0;
lfpos:=pos(#10,data,bytesprocessed+1);
while (lfpos<>0) and (lfpos<=bytesread) do
begin
crcorrectedpos:=lfpos;
if (crcorrectedpos>0) and (data[crcorrectedpos-1]=#13) then
dec(crcorrectedpos);
newstr:=copy(data,bytesprocessed+1,crcorrectedpos-bytesprocessed-1);
fmemo.lines.add(newstr);
inc(stradded);
bytesprocessed:=lfpos;
lfpos:=pos(#10,data,bytesprocessed+1);
end;
inc(fstringsadded,stradded); // check idle event.
end;
end;
end.
I don't know minecraft server, and many external programs might do weird things to the console. But a simple combination of programs to test with is here http://www.stack.nl/~marcov/files/processmemodemo.zip
Based on and using the Jedi Demo VHD, I've created a virtual disk, and can mount and dismount it. When mounted, it appears in the Disk Manager as disk 1 "unknown".
Going on to initialize and format it in my code, I am trying with the following code:
procedure TMainForm.BtnInitClick(Sender: TObject);
var RetBytes: DWORD;
hDevice: Cardinal;
Status: LongBool;
Drive: string;
CDsk : TCreateDisk;
PS : TPartitionStyle;
begin
hDevice := INVALID_HANDLE_VALUE;
Drive := GetDiskPath(Edit1.Text);
hDevice:=CreateFile(PChar(Drive), 0, FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
try
memoinfo.Lines.Add('CreateFile Success. hDevice = '+hDevice.ToString);
CDsk.PartitionStyle := PARTITION_STYLE_GPT;
CDsk.Gpt.DiskId := TGuid.Empty;
CDsk.Gpt.MaxPartitionCount := 0;
Status := DeviceIoControl(hDevice, IOCTL_DISK_CREATE_DISK, #CDsk, SizeOf(CDsk), nil, 0, #RetBytes, nil);
try
memoinfo.Lines.Add('DeviceControl Success');
except
on e: exception do memoinfo.Lines.Add('DeviceControl Error : '+e.Message);
end;
except
on e: exception do memoinfo.Lines.Add('CreateFile Error : '+e.Message);
end;
end;
GetDiskPath gets '\.\PhysicalDisk1' when edit1.text contains the name of my virtual disk (TestDisk.vhd) and both CreateFile and DeviceIoControl generate 'Success', but the disk in Disk Manager stays unchanged.
What am I doing wrong ?
NB! If you have a answer based on C#, that would be fine too.
Does anyone have experience with using the Winspool.EnumprinterData API in Delphi?
I found a demo for C++:
https://s-kita.hatenablog.com/entry/20120227/1330353801
I tried to covert it to Delphi as below:
procedure TForm1.GetPrinterData;
var
hPrinter : THandle;
pInfo: PPrinterInfo2;
bytesNeeded: DWORD;
dwRet : DWORD;
dwIndex: DWORD;
pValueName: PWideChar;
pTagName: PWideChar;
cbValueName: DWORD;
pcbValueName : DWORD;
pType: DWORD;
pData: PByte;
cbData: DWORD;
pcbData: PDWORD;
i : Integer;
printername : String;
dwValueNameSize : DWORD;
dwDataSize : DWORD;
begin
hprinter := GetCurrentPrinterHandle;
dwRet := EnumPrinterDataw(hprinter,i,nil,0, pcbValueName,pType,nil,0,pcbData);
end;
Question 1: EnumPrinterDataW result is not the same, even if I chose the same printer, and it often raises an Access Violation error.
Question 2: the API has many pointer type variables, the next step should allocate memory to some variable, but I do not know how to do thqt. For example pData: PByte; Pdata = Allocmem(pcbData^); <==== this is difficult to me, Pdata is TByte, how to allocmem(pcbData^) is TPwidechar how to do this?
This has taken me 2 days to deal with, and it is still a mess !!!!
There are some mistakes in your code:
you are not checking if GetCurrentPrinterHandle() returns a valid printer handle.
you are not initializing your i variable. You need to pass a 0-based index to EnumPrinterData(), but the value of i is indeterminate.
you are not initializing your pcbData variable. EnumPrinterData() expects a pointer to a DWORD variable that will receive the size of the data written to the pData buffer (or the needed size of the pData buffer if pData is nil). But your pcbData is not pointing to a valid DWORD.
Try something more like this:
procedure TForm1.GetPrinterData;
var
hPrinter: THandle;
dwIndex,
dwRet,
dwType,
dwMaxValueNameSize,
dwMaxDataSize,
dwValueNameSize,
dwDataSize: DWORD;
pValueName,
lpData: array of Byte;
sValueName: UnicodeString; // or WideString in D2007 and earlier
begin
hPrinter := GetCurrentPrinterHandle;
if hPrinter = 0 then
Exit; // or raise an exception
try
dwIndex := 0;
dwRet = EnumPrinterData(hPrinter, dwIndex, nil, 0, dwMaxValueNameSize, dwType, nil, 0, #dwMaxDataSize);
if dwRet = ERROR_NO_MORE_ITEMS then
Exit
else if dwRet <> ERROR_SUCCESS then
RaiseLastOSError(dwRet);
SetLength(pValueName, dwMaxValueNameSize);
SetLength(pData, dwMaxDataSize);
repeat
dwValueNameSize := 0;
dwDataSize := 0;
dwRet = EnumPrinterData(hPrinter, dwIndex, PWideChar(pValueName), dwMaxValueNameSize, dwValueNameSize, dwType, PByte(pData), dwMaxDataSize, #dwDataSize);
if dwRet = ERROR_NO_MORE_ITEMS then
Exit
else if dwRet <> ERROR_SUCCESS then
RaiseLasstOSError(dwRet);
SetLength(sValueName, PWideChar(pValueName), (dwValueNameSize div SizeOf(WideChar)) - 1); // -1 for null terminator
// use dwType, sValueName, and pData up to dwDataSize bytes, as needed...
Inc(dwIndex);
until False;
finally
// only if GetCurrentPrinterHandle returns a handle that needs to be closed now...
ClosePrinter(hPrinter);
end;
end;
Thanks for your great great help!
But have more questions, need your help. (sorry, I'm not good at English)
Q1. in your answer :
SetLength(sValueName, PWideChar(pValueName), (dwValueNameSize div SizeOf(WideChar)) - 1); // -1 for null terminator
I dont understnt this SetLength format.....and complier raise an Error :
[DCC Error] Unit1.pas(111): E2008 Incompatible types
Q2. how to get value :
sValueName ----> ValueName : array of Byte, how to get string value form an array of Byte
sorry for my poor ability. I really do not get pointer type Data, need more study
So I've started playing with SMS and I've tried to make a program (label and button) to hit a website with a post request and display the result.
I have no problems with Hints/Warnings/Errors and everything looks good to me. The following code is a rework of a couple of existing examples mashed together.
procedure TForm1.ExecuteCmd;
var
whttp : TW3HttpRequest;
wParams : string;
begin
wHttp := TW3HttpRequest.Create;
try
whttp.OnDataReady := lambda (Sender)
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
whttp.OnReadyStateChange := lambda (Sender)
if (wHttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
if (w3Label1.caption = '') then
w3Label1.caption := wHttp.ResponseText;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://www.server1.com/executecmd.php');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
finally
wHttp.free;
end;
end;
procedure TForm1.W3Button1Click(Sender: TObject);
begin
ExecuteCmd;
end;
The problem is this, when I actually click the button I get the following error message:
Uncaught TypeError: Cannot read property 'readyState' of null [line #6277]
The error is in the auto generated code and seems to have no relation to what I've written specifically. If I take out all references to ReadyState from my code I still get the error.
What am I missing? I feel like it has something to do with the Lambda functions.
Your problem is that you are expecting whttp.Send to block. Send, as its JavaScript equivalent, is asynchronous. Before the POST could even execute, whttp object is freed (in the finally block). When callback (OnReadyStateChanged) is called, whttp was already freed (and is now null) and you are then trying to call ReadyState on that freed (null) object.
Another reason for confusion is that object.Free in Delphi for Windows/OS X destroys the object while in Smart it merely sets the object reference to nil and leaves the destruction to JavaScript's garbage collection. That's why the whttp is still alive after the Free and why the OnReadyStateChanged is called at all.
This works fine:
uses
W3System, W3Graphics, W3Components, W3Forms, W3Fonts, W3Borders, W3Application,
W3Button, W3Inet, W3Memo;
type
TForm1=class(TW3form)
procedure W3Button1Click(Sender: TObject);
private
{$I 'Form1:intf'}
whttp: TW3HttpRequest;
protected
procedure InitializeForm; override;
procedure InitializeObject; override;
procedure Resize; override;
end;
implementation
{ TForm1}
procedure TForm1.W3Button1Click(Sender: TObject);
var
wParams: string;
begin
whttp := TW3HttpRequest.Create;
whttp.OnReadyStateChange := lambda (Sender)
if (whttp.ReadyState = 4) and (wHttp.Status = 200) then
begin
W3Memo1.Text := wHttp.ResponseText;
whttp.OnReadyStateChange := nil;
whttp := nil;
end;
end;
wParams := 'cmd=TestID1';
whttp.open('POST','http://httpbin.org/post');
whttp.RequestHeaders['Content-type'] := 'application/x-www-form-urlencoded';
whttp.Send(wParams);
end;
I have a straightforward call to a wcf service hosted by iis I'm Delphi 2010
The operation being called on the service could take several minutes
What is the best way of avoiding a timeout error in Delphi?
I deliberately put a Thread.Sleep inside my WCF Service force it to wait for 31 seconds
After 30 seconds I got the error
Project raised exception class ESOAPHTTPException with message 'The handle is in the wrong state for the requested operation - URL:http://10.1.1.4/STC.WcfServices.Host/FlexProcurementService.svc - SOAPAction:http://navsl.stcenergy.com/FlexProcurement/FlexProcurementService/GetPassthroughSummaryGridReportData'.
This turned out to be a bug in Delphi 2010 which I have applied the patch for, so now I get the error operation timed out
function GetFlexProcurementService(const objServiceInfo: TWCFService; UseWSDL: Boolean; Addr: string; HTTPRIO: THTTPRIO): FlexProcurementService;
var
RIO: THTTPRIO;
begin
Result := nil;
if (Addr = '') then
begin
if UseWSDL then
Addr := objServiceInfo.WSDL
else
Addr := objServiceInfo.URL;
end;
if HTTPRIO = nil then
RIO := THTTPRIO.Create(nil)
else
RIO := HTTPRIO;
try
Result := (RIO as FlexProcurementService);
if UseWSDL then
begin
RIO.WSDLLocation := Addr;
RIO.Service := objServiceInfo.Svc;
RIO.Port := objServiceInfo.Prt;
end else
RIO.URL := Addr;
finally
if (Result = nil) and (HTTPRIO = nil) then
RIO.Free;
end;
end;
Paul
uses wininet;
...
function SetTimeout(const HTTPReqResp: THTTPReqResp; Data: Pointer; NumSecs : integer) : boolean;
var
TimeOut: Integer;
begin
// Sets the receive timeout. i.e. how long to wait to 'receive' the response
TimeOut := (NumSecs * 1000);
try
InternetSetOption(Data, INTERNET_OPTION_RECEIVE_TIMEOUT, Pointer(#TimeOut), SizeOf(TimeOut));
InternetSetOption(Data, INTERNET_OPTION_SEND_TIMEOUT, Pointer(#TimeOut), SizeOf(TimeOut));
except on E:Exception do
raise Exception.Create(Format('Unhandled Exception:[%s] while setting timeout to [%d] - ',[E.ClassName, TimeOut, e.Message]));
end;
end;
In the RIO OnBeforePost:
procedure TEETOUpsertWrapper.OnBeforePost(const HTTPReqResp: THTTPReqResp; Data: Pointer); begin
SetTimeout(HTTPReqResp, Data, 5 * 60);
end;