Failure converting sample in lnet to library...

[kcinip]

Code: [Select]

library fpget;

{$mode objfpc}
{$h+}

uses
  sysutils, strutils, lnet, lhttp, lHTTPUtil, lnetSSL, URIParser;

var
  HttpClient: TLHTTPClient;
  {OutputFile: file;}
  Done: boolean;
  outputtext: PChar;

type
  THTTPHandler = class
  public
    procedure ClientDisconnect(ASocket: TLSocket);
    procedure ClientDoneInput(ASocket: TLHTTPClientSocket);
    procedure ClientError(const Msg: string; aSocket: TLSocket);
    function ClientInput(ASocket: TLHTTPClientSocket; ABuffer: pchar;
      ASize: Integer): Integer;
    procedure ClientProcessHeaders(ASocket: TLHTTPClientSocket);
  end;

procedure THTTPHandler.ClientError(const Msg: string; aSocket: TLSocket);
begin
  writeln('Error: ', Msg);
end;

procedure THTTPHandler.ClientDisconnect(ASocket: TLSocket);
begin
  writeln('Disconnected.');
  done := true;
end;
 
procedure THTTPHandler.ClientDoneInput(ASocket: TLHTTPClientSocket);
begin
  writeln('done.');
  {close(OutputFile);}
  ASocket.Disconnect;
end;

function THTTPHandler.ClientInput(ASocket: TLHTTPClientSocket;
  ABuffer: pchar; ASize: Integer): Integer;
begin
 { blockwrite(outputfile, ABuffer^, ASize, Result);
  write(IntToStr(ASize) + '...');                  }
{  outputtext:=ABuffer;}
  strcat(outputtext,ABuffer);
end;

procedure THTTPHandler.ClientProcessHeaders(ASocket: TLHTTPClientSocket);
begin
  write('Response: ', HTTPStatusCodes[ASocket.ResponseStatus], ' ',
    ASocket.ResponseReason, ', data...');
end;

function httpsget(URL: PChar):PChar;stdcall;
var
  Host, URI, FileName, AltFileName: string;
  Port: Word;
  dummy: THTTPHandler;
  index: Integer;
  UseSSL: Boolean;
  SSLSession: TLSSLSession;
begin
  if ParamCount = 0 then
  begin
    writeln('Specify URL (and optionally, filename).');
    exit;
  end;

  { parse URL }
 
  UseSSL := DecomposeURL(URL, Host, URI, Port);
  Writeln('Host: ', Host, ' URI: ', URI, ' Port: ', Port);

  if ParamCount >= 2 then
    FileName := ParamStr(2)
  else begin
    index := RPos('/', URI);
    if index > 0 then
      FileName := Copy(URI, index+1, Length(URI)-index);
    if Length(FileName) = 0 then
      FileName := 'index.html';
  end;

  if FileExists(FileName) then
  begin
    index := 1;
    repeat
      AltFileName := FileName + '.' + IntToStr(index);
      inc(index);
    until not FileExists(AltFileName);
    writeln('"', FileName, '" exists, writing to "', AltFileName, '"');
    FileName := AltFileName;
  end;

{  assign(OutputFile, FileName);}
{  rewrite(OutputFile, 1);}

  HttpClient := TLHTTPClient.Create(nil);

  SSLSession := TLSSLSession.Create(HttpClient);
  SSLSession.SSLActive := UseSSL;

  HttpClient.Session := SSLSession;
  HttpClient.Host := Host;
  HttpClient.Method := hmGet;
  HttpClient.Port := Port;
  HttpClient.URI := URI;
  HttpClient.Timeout := -1;
  HttpClient.OnDisconnect := @dummy.ClientDisconnect;
  HttpClient.OnDoneInput := @dummy.ClientDoneInput;
  HttpClient.OnError := @dummy.ClientError;
  HttpClient.OnInput := @dummy.ClientInput;
  HttpClient.OnProcessHeaders := @dummy.ClientProcessHeaders;
  HttpClient.SendRequest;
  Done := false;

  while not Done do
    HttpClient.CallAction;
  HttpClient.Free;
  result:=outputtext;
end;


exports
  httpsget;

begin
end.
Anyone have done this too? Seems nothing returned in function.

[kcinip]

For reference, the original one is as below:

Code: [Select]

program fpget;

{$mode objfpc}
{$h+}

uses
  sysutils, strutils, lnet, lhttp, lHTTPUtil, lnetSSL, URIParser;

var
  HttpClient: TLHTTPClient;
  OutputFile: file;
  Done: boolean;

type
  THTTPHandler = class
  public
    procedure ClientDisconnect(ASocket: TLSocket);
    procedure ClientDoneInput(ASocket: TLHTTPClientSocket);
    procedure ClientError(const Msg: string; aSocket: TLSocket);
    function ClientInput(ASocket: TLHTTPClientSocket; ABuffer: pchar;
      ASize: Integer): Integer;
    procedure ClientProcessHeaders(ASocket: TLHTTPClientSocket);
  end;

procedure THTTPHandler.ClientError(const Msg: string; aSocket: TLSocket);
begin
  writeln('Error: ', Msg);
end;

procedure THTTPHandler.ClientDisconnect(ASocket: TLSocket);
begin
  writeln('Disconnected.');
  done := true;
end;
 
procedure THTTPHandler.ClientDoneInput(ASocket: TLHTTPClientSocket);
begin
  writeln('done.');
  close(OutputFile);
  ASocket.Disconnect;
end;

function THTTPHandler.ClientInput(ASocket: TLHTTPClientSocket;
  ABuffer: pchar; ASize: Integer): Integer;
begin
  blockwrite(outputfile, ABuffer^, ASize, Result);
  write(IntToStr(ASize) + '...');
end;

procedure THTTPHandler.ClientProcessHeaders(ASocket: TLHTTPClientSocket);
begin
  write('Response: ', HTTPStatusCodes[ASocket.ResponseStatus], ' ',
    ASocket.ResponseReason, ', data...');
end;

var
  URL, Host, URI, FileName, AltFileName: string;
  Port: Word;
  dummy: THTTPHandler;
  index: Integer;
  UseSSL: Boolean;
  SSLSession: TLSSLSession;
begin
  if ParamCount = 0 then
  begin
    writeln('Specify URL (and optionally, filename).');
    exit;
  end;

  { parse URL }
  URL := ParamStr(1);
 
  UseSSL := DecomposeURL(URL, Host, URI, Port);
  Writeln('Host: ', Host, ' URI: ', URI, ' Port: ', Port);

  if ParamCount >= 2 then
    FileName := ParamStr(2)
  else begin
    index := RPos('/', URI);
    if index > 0 then
      FileName := Copy(URI, index+1, Length(URI)-index);
    if Length(FileName) = 0 then
      FileName := 'index.html';
  end;

  if FileExists(FileName) then
  begin
    index := 1;
    repeat
      AltFileName := FileName + '.' + IntToStr(index);
      inc(index);
    until not FileExists(AltFileName);
    writeln('"', FileName, '" exists, writing to "', AltFileName, '"');
    FileName := AltFileName;
  end;

  assign(OutputFile, FileName);
  rewrite(OutputFile, 1);

  HttpClient := TLHTTPClient.Create(nil);

  SSLSession := TLSSLSession.Create(HttpClient);
  SSLSession.SSLActive := UseSSL;

  HttpClient.Session := SSLSession;
  HttpClient.Host := Host;
  HttpClient.Method := hmGet;
  HttpClient.Port := Port;
  HttpClient.URI := URI;
  HttpClient.Timeout := -1;
  HttpClient.OnDisconnect := @dummy.ClientDisconnect;
  HttpClient.OnDoneInput := @dummy.ClientDoneInput;
  HttpClient.OnError := @dummy.ClientError;
  HttpClient.OnInput := @dummy.ClientInput;
  HttpClient.OnProcessHeaders := @dummy.ClientProcessHeaders;
  HttpClient.SendRequest;
  Done := false;

  while not Done do
    HttpClient.CallAction;
  HttpClient.Free;
end.

[KpjComp]

I can see a couple of problems.

1.  I can't see anywhere your allocating memory for outputtext, as it's a PChar it's an unmanaged type, meaning you have to handle allocations.   I'm surprised your not getting access violations.

2.  strcat is used for copying C style strings, in other words NULL (0) terminated strings, if this is for downloading binary data then you could of course have 0's in there.

[kcinip]

I changed the outputtext from PChar to ansistring,
and changed the use of strcat to
outputtext:=outputtext+ABuffer^;

Still compiles to DLL.
But still nothing returned from the exported function, while the original version compiled to EXE has correct output...

[kcinip]

Correct output for compiled EXE but incorrect output for DLL with the line:

Code: [Select]

outputtext:=outputtext+ABuffer^;
The output for DLL is correct again after the line changed to:

Code: [Select]

outputtext:=outputtext+Ansistring(ABuffer);
Don't know why...
Maybe I need to read more about variable types of Pascal...

[KpjComp]

Don't know why...

ABuffer is a PChar type, an understanding of pointers is really needed here.
But what this basically means is that ABuffer is a pointer to a Char not a string.

So if you do ABuffer^, your dereferencing a Char, not a string.  IOW: you will be getting the first character of the ABuffer block.

A PChar is also not really a good container for binary data, like I mentioned PChar are expected to be NULL (0) terminated.  If your only using this to grab HTML then you should be OK, but if say you later wanted to capture 8bit encoded HTML responses, eg. a JPeg image etc, then you will get problems unless they are encoded in say something like BASE64.

edit: Also you might have issues with using Ansistring(ABuffer);  If this function returns data in blocks, each block is unlikely to have a NULL at the end, if your lucky the NULL will be at the end of the block, aka the next byte after the block.  Ideally you really want to use SetLength on your buffer and move the bytes instead.  ps.  HTML headers normally have the Content-Length attribute, this will make allocating your buffer faster too, instead of constant string expansion.  Handy for when the files you download become big.