Skip to content

Instantly share code, notes, and snippets.

@TobiX
Created December 18, 2012 15:49
Show Gist options
  • Save TobiX/4329152 to your computer and use it in GitHub Desktop.
Save TobiX/4329152 to your computer and use it in GitHub Desktop.
Patch for WinInet error handling
Index: SynCrtSock.pas
===================================================================
--- SynCrtSock.pas (revision 53301)
+++ SynCrtSock.pas (working copy)
@@ -900,9 +900,12 @@
/// WinINet exception type
EWinINet = class(Exception)
+ private
+ fCode: Cardinal;
public
/// create a WinINet exception, with the error message as text
constructor Create;
+ property ErrorCode: cardinal read fCode;
end;
{/ a class to handle HTTP/1.1 request using the WinHTTP API
@@ -4103,17 +4106,33 @@
{ EWinINet }
constructor EWinINet.Create;
-var tmp: array[byte] of Char;
+var err: PChar;
dwError, tmpLen: DWORD;
- msg: string;
- lastError: cardinal;
+ msg, tmp: string;
begin
- lastError := GetLastError;
- tmpLen := 255;
- if InternetGetLastResponseInfo({$ifdef FPC}@{$endif}dwError,tmp,tmpLen) and (tmpLen>0) then
- SetString(msg,tmp,tmpLen) else
- msg := 'Error';
- inherited CreateFmt('%s (%d)',[msg,lastError]);
+ fCode := GetLastError;
+ msg := 'Error';
+
+ tmpLen := FormatMessage(FORMAT_MESSAGE_FROM_HMODULE or FORMAT_MESSAGE_ALLOCATE_BUFFER,
+ Pointer(GetModuleHandle('wininet.dll')), fCode, 0, @err, 0, nil);
+ // See SysUtils.SysErrorMessage
+ try
+ while (tmpLen > 0) and (CharInSet(err[tmpLen - 1], [#0..#32, '.'])) do Dec(tmpLen);
+ SetString(msg, err, tmpLen);
+ finally
+ LocalFree(HLOCAL(err));
+ end;
+
+ if fCode = ERROR_INTERNET_EXTENDED_ERROR then begin
+ InternetGetLastResponseInfo({$ifdef FPC}@{$endif}dwError,nil,tmpLen);
+ if tmpLen > 0 then begin
+ SetLength(tmp, tmpLen);
+ InternetGetLastResponseInfo({$ifdef FPC}@{$endif}dwError,PChar(tmp),tmpLen);
+ msg := msg + ' [' + tmp + ']';
+ end;
+ end;
+
+ inherited CreateFmt('%s (%d)',[msg,fCode]);
end;
@@ -4132,7 +4151,7 @@
begin
if (hdr<>'') and not HttpAddRequestHeadersA(fRequest,
Pointer(hdr), length(hdr), HTTP_ADDREQ_FLAG_COALESCE) then
- EWinINet.Create;
+ raise EWinINet.Create;
end;
procedure TWinINet.InternalCloseRequest;
@@ -4200,13 +4219,13 @@
FRequest := HttpOpenRequestA(FConnection, Pointer(method), Pointer(aURL), nil,
nil, @ALL_ACCEPT, Flags,0);
if FRequest=nil then
- EWinINet.Create;
+ raise EWinINet.Create;
end;
procedure TWinINet.InternalSendRequest(const aData: RawByteString);
begin
if not HttpSendRequestA(fRequest, nil, 0, pointer(aData), length(aData)) then
- EWinINet.Create;
+ raise EWinINet.Create;
end;
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment