[Last Call] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 1236
  • Last Modified:

Delphi Download xml from https

Hello,

I would like to download an xml from a https site to a memo. The site is username and password protected. I am very beginner in this.

How can I do that? (if it is possible a step-by-step answer)

Thank you.
0
whpgabesz
Asked:
whpgabesz
  • 5
  • 3
  • 2
1 Solution
 
maosalahCommented:
try this function used WinInet for downloading. This is the code that worked for me:
function Download(URL, User, Pass, FileName: string): Boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: DWORD;
  F: File;
begin
   Result := False;
   hSession := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;

   // Establish the secure connection
   InternetConnect (
     hSession,
     PChar(FullURL),
     INTERNET_DEFAULT_HTTPS_PORT,
     PChar(User),
     PChar(Pass),
     INTERNET_SERVICE_HTTP,
     0,
     0
   );

  try
    hURL := InternetOpenURL(hSession, PChar(URL), nil, 0, 0, 0) ;
    try
      AssignFile(f, FileName);
      Rewrite(f,1);
      try
        repeat
          InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) ;
          BlockWrite(f, Buffer, BufferLen)
        until BufferLen = 0;
      finally
        CloseFile(f) ;
        Result := True;
      end;
    finally
      InternetCloseHandle(hURL)
    end
  finally
    InternetCloseHandle(hSession)
  end;
end;

Open in new window

0
 
Ephraim WangoyaCommented:

The basics are to use TidHTTP and TIdSSLIOHandlerSocketOpenSSL components from Indy

You also have to download the open SSL libraries from
http://indy.fulgan.com/SSL/

For TidHTTP to use ssl, set the IOHandler property to the SSL component

IdHTTP1.IOHandler := IdSSLIOHandlerSocketOpenSSL1;

Then set the SSL version
IdSSLIOHandlerSocketOpenSSL1.SSLOptions.Method := sslvSSLV3

Communicatiing with the server just involves calling Post or Get methods of IdHTTP1
The Post method will return a string which you can then examine

eg
var
  Response: string;
begin
  Response := IdHTTP1.Post('http://www.myhome.com');
end;

For what you are describing above I believe the server is expecting some kind of instructions from you in order to give you back the XML

I suggest you read up on Indy components and look at a few examples to begin with so you can get a better understanding of the issue.




0
 
whpgabeszAuthor Commented:
maosalah: there is an error in your code : PChar(FullURL) -> PChar(URL)
Anyway it generates a very big file, without the real content.
0
New Tabletop Appliances Blow Competitors Away!

WatchGuard’s new T15, T35 and T55 tabletop UTMs provide the highest-performing security inspection in their class, allowing users at small offices, home offices and distributed enterprises to experience blazing-fast Internet speeds without sacrificing enterprise-grade security.

 
whpgabeszAuthor Commented:
ewangoya:

How can I install TIdSSLIOHandlerSocketOpenSSL  to delphi 7?
I downloaded the 2 dlls.
0
 
Ephraim WangoyaCommented:

This should already be in your delphi 7, check the Indy components
0
 
maosalahCommented:
hi,

I retry it and it's work fine so change the PChar(FullURL) to PChar(URL)


try that


unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, WinInet;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Déclarations privées }
  public
    { Déclarations publiques }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}
function Download(URL, User, Pass, FileName: string): Boolean;
const
  BufferSize = 1024;
var
  hSession, hURL: HInternet;
  Buffer: array[1..BufferSize] of Byte;
  BufferLen: DWORD;
  F: File;
begin
   Result := False;
   hSession := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0) ;

   // Establish the secure connection
   InternetConnect (
     hSession,
     PChar(URL),
     INTERNET_DEFAULT_HTTPS_PORT,
     PChar(User),
     PChar(Pass),
     INTERNET_SERVICE_HTTP,
     0,
     0
   );

  try
    hURL := InternetOpenURL(hSession, PChar(URL), nil, 0, 0, 0) ;
    try
      AssignFile(f, FileName);
      Rewrite(f,1);
      try
        repeat
          InternetReadFile(hURL, @Buffer, SizeOf(Buffer), BufferLen) ;
          BlockWrite(f, Buffer, BufferLen)
        until BufferLen = 0;
      finally
        CloseFile(f) ;
        Result := True;
      end;
    finally
      InternetCloseHandle(hURL)
    end
  finally
    InternetCloseHandle(hSession)
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 if Download('https://xml.shavlik.com/mssecure.xml','','','c:\MyFile.xml') then
    showmessage('Download successfully ...')
 else
    showmessage('Error Url ...');

memo1.Lines.LoadFromFile('c:\MyFile.xml');
end;

end.

Open in new window

0
 
whpgabeszAuthor Commented:
Hi!

Now your code seems to be working with your https address. But with mine it says I/O error 1784.
I think it some how it can not pass the identification. Anyway the error means the buffer is incorrect...
0
 
whpgabeszAuthor Commented:
I found a really good solution, which directly put the result into a string and not a file.
Just a remark, after the crackurl, you need to write the username and password again, and it will work.

procedure CrackURL(const URL: String; out Scheme: Word; out UserName, Password, Host: String; out Port: Word; out ObjName: String);
var
  Parts: TURLComponents;
  CanonicalURL: String;
  Size: Cardinal;
begin
  FillChar(Parts, SizeOf(TURLComponents), 0);
  Parts.dwStructSize := SizeOf(TURLComponents);
  if URL <> '' then
  begin
    Size := 3 * Length(URL);
    SetString(CanonicalURL, nil, Size);
    if not InternetCanonicalizeUrl(PChar(URL), PChar(CanonicalURL), Size, ICU_NO_META) then
      Size := 0;
    SetLength(CanonicalURL, Size);
    Parts.dwSchemeLength := 1;
    Parts.dwUserNameLength := 1;
    Parts.dwPasswordLength := 1;
    Parts.dwHostNameLength := 1;
    Parts.dwURLPathLength := 1;
    Parts.dwExtraInfoLength := 1;
    InternetCrackUrl(PChar(CanonicalURL), Size, 0, Parts);
  end;
  Scheme := Parts.nScheme;
  SetString(UserName, Parts.lpszUserName, Parts.dwUserNameLength);
  SetString(Password, Parts.lpszPassword, Parts.dwPasswordLength);
  SetString(Host, Parts.lpszHostName, Parts.dwHostNameLength);
  Port := Parts.nPort;
  SetString(ObjName, Parts.lpszUrlPath, Parts.dwUrlPathLength + Parts.dwExtraInfoLength);
end;

function GetUrlContent(const URL: String): String;
const
  AcceptType: array[0..1] of PChar = ('*/*', nil);
var
  hINet, hConn, hReq: HINTERNET;
  UserName, Password, Host, ObjName: String;
  Scheme, Port: Word;
  dwSize, dwError: DWORD;
  ReqFlags, Size: Cardinal;
  Stream: TStringStream;
  Buffer: array[0..255] of Byte;
begin
  Result := '';
  hINet := InternetOpen('Mozila/5.0', INTERNET_OPEN_TYPE_PRECONFIG, nil, nil, 0);
  if hINet <> nil then begin
    try
      CrackURL(URL, Scheme, UserName, Password, Host, Port, ObjName);
      hConn := InternetConnect(hINet, PChar(Host), Port, PChar(UserName), PChar(Password), INTERNET_SERVICE_HTTP, 0, 0);
      if hConn <> nil then begin
        try
          ReqFlags := INTERNET_FLAG_RELOAD or INTERNET_FLAG_PRAGMA_NOCACHE
                   or INTERNET_FLAG_NO_CACHE_WRITE or INTERNET_FLAG_NO_COOKIES
                   or INTERNET_FLAG_NO_UI or INTERNET_FLAG_KEEP_CONNECTION;
          if Scheme = INTERNET_SCHEME_HTTPS then begin
            ReqFlags := ReqFlags or INTERNET_FLAG_SECURE;
          end;
          hReq := HttpOpenRequest(hConn, 'GET', PChar(ObjName), nil, nil, @AcceptType[0], ReqFlags, 0);
          if hReq <> nil then begin
            dwSize:=SizeOf(ReqFlags);
            // Get the current flags
            if Scheme = INTERNET_SCHEME_HTTPS then begin
              if (InternetQueryOption(hReq, INTERNET_OPTION_SECURITY_FLAGS, @ReqFlags, dwSize)) then begin
                 // Add desired flags
                 ReqFlags := ReqFlags or SECURITY_FLAG_IGNORE_UNKNOWN_CA or SECURITY_FLAG_IGNORE_CERT_CN_INVALID or SECURITY_FLAG_IGNORE_CERT_DATE_INVALID or SECURITY_FLAG_IGNORE_REVOCATION;
                 // Set new flags
                 if not(InternetSetOption(hReq, INTERNET_OPTION_SECURITY_FLAGS, @ReqFlags, dwSize)) then begin
                    // Get error code
                    dwError := GetLastError;
                    // Failure
                    MessageBox(0, PChar(IntToStr(dwError)), PChar('Confirm'), MB_OK or MB_ICONINFORMATION);
                 end;
              end else begin
                 // Get error code
                 dwError := GetLastError;
                 // Failure
                 MessageBox(0, PChar(IntToStr(dwError)), PChar('Confirm'), MB_OK or MB_ICONINFORMATION);
              end;
            end;

            try
              if HttpSendRequest(hReq, nil, 0, nil, 0) then begin
                Stream := TStringStream.Create('');
                try
                  while InternetReadFile(hReq, @Buffer[0], SizeOf(Buffer), Size) and (Size <> 0) do begin
                    Stream.Write(Buffer[0], Size);
                  end;
                  Result := Stream.DataString;
                finally
                  Stream.Free;
                end;
              end;
            finally
              dwError := GetLastError;
//              MessageBox(0, PChar(IntToStr(dwError)), PChar('Confirm'), MB_OK or MB_ICONINFORMATION);
              InternetCloseHandle(hReq);
            end;
          end;
        finally
          InternetCloseHandle(hConn);
        end;
      end;
    finally
      InternetCloseHandle(hINet);
    end;
  end;  
end;

Open in new window

0
 
Ephraim WangoyaCommented:

Oh, If you are using Delphi 7 which come with Indy9 then you use
TIdSSLIOHandlerSocket

In Indy10 its changed to
TIdSSLIOHandlerSocketOpenSSL
0
 
whpgabeszAuthor Commented:
I found the answer myself.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

  • 5
  • 3
  • 2
Tackle projects and never again get stuck behind a technical roadblock.
Join Now