* Deprecated in favour of fcl-web and WST

git-svn-id: trunk@15346 -

.gitattributes

@@ -2031,20 +2031,15 @@ packages/fcl-net/examples/testuri.pp svneol=native#text/plain
 packages/fcl-net/fpmake.pp svneol=native#text/plain
 packages/fcl-net/src/cnetdb.pp svneol=native#text/plain
 packages/fcl-net/src/fpsock.pp svneol=native#text/plain
-packages/fcl-net/src/httpbase.pp svneol=native#text/plain
-packages/fcl-net/src/httpclient.pp svneol=native#text/plain
 packages/fcl-net/src/httpsvlt.pp svneol=native#text/plain
-packages/fcl-net/src/mkxmlrpc.pp svneol=native#text/plain
 packages/fcl-net/src/netdb.pp svneol=native#text/plain
 packages/fcl-net/src/netware/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/netwlibc/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/os2/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/resolve.pp svneol=native#text/plain
-packages/fcl-net/src/servlets.pp svneol=native#text/plain
 packages/fcl-net/src/ssockets.pp svneol=native#text/plain
 packages/fcl-net/src/unix/resolve.inc svneol=native#text/plain
 packages/fcl-net/src/win/resolve.inc svneol=native#text/plain
-packages/fcl-net/src/xmlrpc.pp svneol=native#text/plain
 packages/fcl-passrc/Makefile svneol=native#text/plain
 packages/fcl-passrc/Makefile.fpc svneol=native#text/plain
 packages/fcl-passrc/examples/test_parser.pp svneol=native#text/plain

packages/fcl-net/src/httpbase.pp

@@ -1,488 +0,0 @@
-{
-
-    HTTPBase: Common HTTP utility declarations and classes
-    Copyright (C) 2000-2003 by Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-}
-
-{$mode objfpc}
-{$H+}
-
-unit HTTPBase;
-
-interface
-
-
-uses Classes, fpAsync;
-
-const
-
-  fieldAccept = 'Accept';
-  fieldAcceptCharset = 'Accept-Charset';
-  fieldAcceptEncoding = 'Accept-Encoding';
-  fieldAcceptLanguage = 'Accept-Language';
-  fieldAuthorization = 'Authorization';
-  fieldConnection = 'Connection';
-  fieldContentEncoding = 'Content-Encoding';
-  fieldContentLanguage = 'Content-Language';
-  fieldContentLength = 'Content-Length';
-  fieldContentType = 'Content-Type';
-  fieldCookie = 'Cookie';
-  fieldDate = 'Date';
-  fieldExpires = 'Expires';
-  fieldFrom = 'From';
-  fieldIfModifiedSince = 'If-Modified-Since';
-  fieldLastModified = 'Last-Modified';
-  fieldLocation = 'Location';
-  fieldPragma = 'Pragma';
-  fieldReferer = 'Referer';
-  fieldRetryAfter = 'Retry-After';
-  fieldServer = 'Server';
-  fieldSetCookie = 'Set-Cookie';
-  fieldUserAgent = 'User-Agent';
-  fieldWWWAuthenticate = 'WWW-Authenticate';
-
-type
-
-  PHttpField = ^THttpField;
-  THttpField = record
-    Name, Value: String;
-  end;
-
-
-  THttpHeader = class
-  protected
-    FReader: TAsyncStreamLineReader;
-    FWriter: TAsyncWriteStream;
-    FOnCompleted: TNotifyEvent;
-    FOnEOF: TNotifyEvent;
-    FFields: TList;
-
-    procedure ParseFirstHeaderLine(const line: String); virtual; abstract;
-    procedure LineReceived(const ALine: String);
-    procedure ReaderEOF(Sender: TObject);
-    function GetFirstHeaderLine: String; virtual; abstract;
-    procedure WriterCompleted(ASender: TObject);
-
-    function GetFieldCount: Integer;
-    function GetFields(AIndex: Integer): String;
-    function GetFieldNames(AIndex: Integer): String;
-    procedure SetFieldNames(AIndex: Integer; const AName: String);
-    function GetFieldValues(AIndex: Integer): String;
-    procedure SetFieldValues(AIndex: Integer; const AValue: String);
-
-
-    function  GetAccept: String;
-    procedure SetAccept(const AValue: String);
-    function  GetAcceptCharset: String;
-    procedure SetAcceptCharset(const AValue: String);
-    function  GetAcceptEncoding: String;
-    procedure SetAcceptEncoding(const AValue: String);
-    function  GetAcceptLanguage: String;
-    procedure SetAcceptLanguage(const AValue: String);
-    function  GetAuthorization: String;
-    procedure SetAuthorization(const AValue: String);
-    function  GetConnection: String;
-    procedure SetConnection(const AValue: String);
-    function  GetContentEncoding: String;
-    procedure SetContentEncoding(const AValue: String);
-    function  GetContentLanguage: String;
-    procedure SetContentLanguage(const AValue: String);
-    function  GetContentLength: Integer;
-    procedure SetContentLength(AValue: Integer);
-    function  GetContentType: String;
-    procedure SetContentType(const AValue: String);
-    function  Get_Cookie: String;
-    procedure Set_Cookie(const AValue: String);
-    function  GetDate: String;
-    procedure SetDate(const AValue: String);
-    function  GetExpires: String;
-    procedure SetExpires(const AValue: String);
-    function  GetFrom: String;
-    procedure SetFrom(const AValue: String);
-    function  GetIfModifiedSince: String;
-    procedure SetIfModifiedSince(const AValue: String);
-    function  GetLastModified: String;
-    procedure SetLastModified(const AValue: String);
-    function  GetLocation: String;
-    procedure SetLocation(const AValue: String);
-    function  GetPragma: String;
-    procedure SetPragma(const AValue: String);
-    function  GetReferer: String;
-    procedure SetReferer(const AValue: String);
-    function  GetRetryAfter: String;
-    procedure SetRetryAfter(const AValue: String);
-    function  GetServer: String;
-    procedure SetServer(const AValue: String);
-    function  Get_SetCookie: String;
-    procedure Set_SetCookie(const AValue: String);
-    function  GetUserAgent: String;
-    procedure SetUserAgent(const AValue: String);
-    function  GetWWWAuthenticate: String;
-    procedure SetWWWAuthenticate(const AValue: String);
-
-  public
-    DataReceived, CmdReceived: Boolean;         // !!!: Only temporarily here
-
-    HttpVersion: String;
-
-    constructor Create;
-    destructor Destroy; override;
-    procedure SetFieldByName(const AName, AValue: String);
-    function  GetFieldByName(const AName: String): String;
-
-    procedure AsyncSend(AManager: TEventLoop; AStream: THandleStream);
-    procedure AsyncReceive(AManager: TEventLoop; AStream: THandleStream);
-
-    property Reader: TAsyncStreamLineReader read FReader;
-    property Writer: TAsyncWriteStream read FWriter;
-    property FieldCount: Integer read GetFieldCount;
-    property Fields[AIndex: Integer]: String read GetFields;
-    property FieldNames[AIndex: Integer]: String read GetFieldNames write SetFieldNames;
-    property FieldValues[AIndex: Integer]: String read GetFieldValues write SetFieldValues;
-
-    property OnCompleted: TNotifyEvent read FOnCompleted write FOnCompleted;
-    property OnEOF: TNotifyEvent read FOnEOF write FOnEOF;
-
-    property Accept: String read GetAccept write SetAccept;
-    property AcceptCharset: String read GetAcceptCharset write SetAcceptCharset;
-    property AcceptEncoding: String read GetAcceptEncoding write SetAcceptEncoding;
-    property AcceptLanguage: String read GetAcceptLanguage write SetAcceptLanguage;
-    property Authorization: String read GetAuthorization write SetAuthorization;
-    property Connection: String read GetConnection write SetConnection;
-    property ContentEncoding: String read GetContentEncoding write SetContentEncoding;
-    property ContentLanguage: String read GetContentLanguage write SetContentLanguage;
-    property ContentLength: Integer read GetContentLength write SetContentLength;
-    property ContentType: String read GetContentType write SetContentType;
-    property Cookie: String read Get_Cookie write Set_Cookie;
-    property Date: String read GetDate write SetDate;
-    property Expires: String read GetExpires write SetExpires;
-    property From: String read GetFrom write SetFrom;
-    property IfModifiedSince: String read GetIfModifiedSince write SetIfModifiedSince;
-    property LastModified: String read GetLastModified write SetLastModified;
-    property Location: String read GetLocation write SetLocation;
-    property Pragma: String read GetPragma write SetPragma;
-    property Referer: String read GetReferer write SetReferer;
-    property RetryAfter: String read GetRetryAfter write SetRetryAfter;
-    property Server: String read GetServer write SetServer;
-    property SetCookie: String read Get_SetCookie write Set_SetCookie;
-    property UserAgent: String read GetUserAgent write SetUserAgent;
-    property WWWAuthenticate: String read GetWWWAuthenticate write SetWWWAuthenticate;
-  end;
-
-
-  THttpRequestHeader = class(THttpHeader)
-  protected
-    procedure ParseFirstHeaderLine(const line: String); override;
-    function  GetFirstHeaderLine: String; override;
-  public
-    CommandLine: String;
-    Command: String;
-    URI: String;                // Uniform Resource Identifier
-    QueryString: String;
-  end;
-
-
-  THttpResponseHeader = class(THttpHeader)
-  protected
-    procedure ParseFirstHeaderLine(const line: String); override;
-    function  GetFirstHeaderLine: String; override;
-  public
-    Code: Integer;
-    CodeText: String;
-    constructor Create;
-  end;
-
-
-implementation
-
-uses SysUtils;
-
-
-// THttpHeader
-
-procedure THttpHeader.LineReceived(const ALine: String);
-var
-  i: Integer;
-begin
-  if Length(ALine) = 0 then
-  begin
-    FReader.OnLine := nil;      // Stop receiving
-    FReader.StopAndFree;
-    if Assigned(FOnCompleted) then
-      FOnCompleted(Self);
-    FReader := nil;
-  end else
-    DataReceived := True;
-    if not CmdReceived then
-    begin
-      CmdReceived := True;
-      ParseFirstHeaderLine(ALine);
-    end else
-    begin
-      i := Pos(':', ALine);
-      SetFieldByName(Trim(Copy(ALine, 1, i - 1)),
-        Trim(Copy(ALine, i + 1, Length(ALine))));
-    end;
-end;
-
-procedure THttpHeader.ReaderEOF(Sender: TObject);
-begin
-  if Assigned(OnEOF) then
-    OnEOF(Self);
-end;
-
-procedure THttpHeader.WriterCompleted(ASender: TObject);
-begin
-  if Assigned(FOnCompleted) then
-    FOnCompleted(Self);
-  FreeAndNil(FWriter);
-end;
-
-function THttpHeader.GetFieldCount: Integer;
-begin
-  Result := FFields.Count;
-end;
-
-function THttpHeader.GetFields(AIndex: Integer): String;
-begin
-  Result := FieldNames[AIndex] + ': ' + FieldValues[AIndex];
-end;
-
-function THttpHeader.GetFieldNames(AIndex: Integer): String;
-begin
-  Result := PHttpField(FFields.Items[AIndex])^.Name;
-end;
-
-procedure THttpHeader.SetFieldNames(AIndex: Integer; const AName: String);
-begin
-  PHttpField(FFields.Items[AIndex])^.Name := AName;
-end;
-
-function THttpHeader.GetFieldValues(AIndex: Integer): String;
-begin
-  Result := PHttpField(FFields.Items[AIndex])^.Value;
-end;
-
-procedure THttpHeader.SetFieldValues(AIndex: Integer; const AValue: String);
-begin
-  PHttpField(FFields.Items[AIndex])^.Value := AValue;
-end;
-
-function  THttpHeader.GetAccept: String; begin Result := GetFieldByName(fieldAccept) end;
-procedure THttpHeader.SetAccept(const AValue: String); begin SetFieldByName(fieldAccept, AValue) end;
-function  THttpHeader.GetAcceptCharset: String; begin Result := GetFieldByName(fieldAcceptCharset) end;
-procedure THttpHeader.SetAcceptCharset(const AValue: String); begin SetFieldByName(fieldAcceptCharset, AValue) end;
-function  THttpHeader.GetAcceptEncoding: String; begin Result := GetFieldByName(fieldAcceptEncoding) end;
-procedure THttpHeader.SetAcceptEncoding(const AValue: String); begin SetFieldByName(fieldAcceptEncoding, AValue) end;
-function  THttpHeader.GetAcceptLanguage: String; begin Result := GetFieldByName(fieldAcceptLanguage) end;
-procedure THttpHeader.SetAcceptLanguage(const AValue: String); begin SetFieldByName(fieldAcceptLanguage, AValue) end;
-function  THttpHeader.GetAuthorization: String; begin Result := GetFieldByName(fieldAuthorization) end;
-procedure THttpHeader.SetAuthorization(const AValue: String); begin SetFieldByName(fieldAuthorization, AValue) end;
-function  THttpHeader.GetConnection: String; begin Result := GetFieldByName(fieldConnection) end;
-procedure THttpHeader.SetConnection(const AValue: String); begin SetFieldByName(fieldConnection, AValue) end;
-function  THttpHeader.GetContentEncoding: String; begin Result := GetFieldByName(fieldContentEncoding) end;
-procedure THttpHeader.SetContentEncoding(const AValue: String); begin SetFieldByName(fieldContentEncoding, AValue) end;
-function  THttpHeader.GetContentLanguage: String; begin Result := GetFieldByName(fieldContentLanguage) end;
-procedure THttpHeader.SetContentLanguage(const AValue: String); begin SetFieldByName(fieldContentLanguage, AValue) end;
-function  THttpHeader.GetContentLength: Integer; var s: String; begin s := GetFieldByName(fieldContentLength); if Length(s) = 0 then Result := -1 else Result := StrToInt(s) end;
-procedure THttpHeader.SetContentLength(AValue: Integer); begin SetFieldByName(fieldContentLength, IntToStr(AValue)) end;
-function  THttpHeader.GetContentType: String; begin Result := GetFieldByName(fieldContentType) end;
-procedure THttpHeader.SetContentType(const AValue: String); begin SetFieldByName(fieldContentType, AValue) end;
-function  THttpHeader.Get_Cookie: String; begin Result := GetFieldByName(fieldCookie) end;
-procedure THttpHeader.Set_Cookie(const AValue: String); begin SetFieldByName(fieldCookie, AValue) end;
-function  THttpHeader.GetDate: String; begin Result := GetFieldByName(fieldDate) end;
-procedure THttpHeader.SetDate(const AValue: String); begin SetFieldByName(fieldDate, AValue) end;
-function  THttpHeader.GetExpires: String; begin Result := GetFieldByName(fieldExpires) end;
-procedure THttpHeader.SetExpires(const AValue: String); begin SetFieldByName(fieldExpires, AValue) end;
-function  THttpHeader.GetFrom: String; begin Result := GetFieldByName(fieldFrom) end;
-procedure THttpHeader.SetFrom(const AValue: String); begin SetFieldByName(fieldFrom, AValue) end;
-function  THttpHeader.GetIfModifiedSince: String; begin Result := GetFieldByName(fieldIfModifiedSince) end;
-procedure THttpHeader.SetIfModifiedSince(const AValue: String); begin SetFieldByName(fieldIfModifiedSince, AValue) end;
-function  THttpHeader.GetLastModified: String; begin Result := GetFieldByName(fieldLastModified) end;
-procedure THttpHeader.SetLastModified(const AValue: String); begin SetFieldByName(fieldLastModified, AValue) end;
-function  THttpHeader.GetLocation: String; begin Result := GetFieldByName(fieldLocation) end;
-procedure THttpHeader.SetLocation(const AValue: String); begin SetFieldByName(fieldLocation, AValue) end;
-function  THttpHeader.GetPragma: String; begin Result := GetFieldByName(fieldPragma) end;
-procedure THttpHeader.SetPragma(const AValue: String); begin SetFieldByName(fieldPragma, AValue) end;
-function  THttpHeader.GetReferer: String; begin Result := GetFieldByName(fieldReferer) end;
-procedure THttpHeader.SetReferer(const AValue: String); begin SetFieldByName(fieldReferer, AValue) end;
-function  THttpHeader.GetRetryAfter: String; begin Result := GetFieldByName(fieldRetryAfter) end;
-procedure THttpHeader.SetRetryAfter(const AValue: String); begin SetFieldByName(fieldRetryAfter, AValue) end;
-function  THttpHeader.GetServer: String; begin Result := GetFieldByName(fieldServer) end;
-procedure THttpHeader.SetServer(const AValue: String); begin SetFieldByName(fieldServer, AValue) end;
-function  THttpHeader.Get_SetCookie: String; begin Result := GetFieldByName(fieldSetCookie) end;
-procedure THttpHeader.Set_SetCookie(const AValue: String); begin SetFieldByName(fieldSetCookie, AValue) end;
-function  THttpHeader.GetUserAgent: String; begin Result := GetFieldByName(fieldUserAgent) end;
-procedure THttpHeader.SetUserAgent(const AValue: String); begin SetFieldByName(fieldUserAgent, AValue) end;
-function  THttpHeader.GetWWWAuthenticate: String; begin Result := GetFieldByName(fieldWWWAuthenticate) end;
-procedure THttpHeader.SetWWWAuthenticate(const AValue: String); begin SetFieldByName(fieldWWWAuthenticate, AValue) end;
-
-constructor THttpHeader.Create;
-begin
-  inherited Create;
-  FFields := TList.Create;
-  HttpVersion := '1.1';
-end;
-
-destructor THttpHeader.Destroy;
-var
-  i: Integer;
-  Field: PHttpField;
-begin
-  if Assigned(FReader) then
-    FReader.StopAndFree;
-  if Assigned(FWriter) then
-    FWriter.StopAndFree;
-  for i := 0 to FFields.Count - 1 do
-  begin
-    Field := PHttpField(FFields.Items[i]);
-{    SetLength(Field^.Name, 0);
-    SetLength(Field^.Value, 0);}
-    Dispose(Field);
-  end;
-  FFields.Free;
-  inherited Destroy;
-end;
-
-function THttpHeader.GetFieldByName(const AName: String): String;
-var
-  i: Integer;
-  Name: String;
-begin
-  Name := UpperCase(AName);
-  for i := 0 to FFields.Count - 1 do
-    if UpperCase(FieldNames[i]) = Name then
-    begin
-      Result := FieldValues[i];
-      exit;
-    end;
-  SetLength(Result, 0);
-end;
-
-procedure THttpHeader.SetFieldByName(const AName, AValue: String);
-var
-  i: Integer;
-  Name: String;
-  Field: PHttpField;
-begin
-  Name := UpperCase(AName);
-  for i := 0 to FFields.Count - 1 do
-    if UpperCase(FieldNames[i]) = Name then
-    begin
-      FieldNames[i] := AName;   // preserve case
-      FieldValues[i] := AValue;
-      exit;
-    end;
-  New(Field);
-  FillChar(Field^, SizeOf(Field^), 0);
-  Field^.Name := AName;
-  Field^.Value := AValue;
-  FFields.Add(field);
-end;
-
-procedure THttpHeader.AsyncSend(AManager: TEventLoop; AStream: THandleStream);
-var
-  i: Integer;
-begin
-  if Assigned(FWriter) then
-    FWriter.StopAndFree;
-  FWriter := TAsyncWriteStream.Create(AManager, AStream);
-  FWriter.OnBufferSent := @WriterCompleted;
-  FWriter.EndOfLineMarker := #13#10;
-  FWriter.WriteLine(GetFirstHeaderLine);
-  for i := 0 to FFields.Count - 1 do
-    FWriter.WriteLine(Fields[i]);
-  FWriter.WriteLine('');
-end;
-
-procedure THttpHeader.AsyncReceive(AManager: TEventLoop; AStream: THandleStream);
-begin
-  CmdReceived := False;
-  FReader.Free;
-  FReader := TAsyncStreamLineReader.Create(AManager, AStream);
-  FReader.OnLine := @LineReceived;
-  FReader.OnEOF := @ReaderEOF;
-end;
-
-
-// -------------------------------------------------------------------
-//   THttpRequestHeader
-// -------------------------------------------------------------------
-
-procedure THttpRequestHeader.ParseFirstHeaderLine(const line: String);
-var
-  i: Integer;
-begin
-  CommandLine := line;
-  i := Pos(' ', line);
-  Command := UpperCase(Copy(line, 1, i - 1));
-  URI := Copy(line, i + 1, Length(line));
-
-  // Extract HTTP version
-  i := Pos(' ', URI);
-  if i > 0 then
-  begin
-    HttpVersion := Copy(URI, i + 1, Length(URI));
-    URI := Copy(URI, 1, i - 1);
-    HttpVersion := Copy(HttpVersion, Pos('/', HttpVersion) + 1, Length(HttpVersion));
-  end;
-
-  // Extract query string
-  i := Pos('?', URI);
-  if i > 0 then
-  begin
-    QueryString := Copy(URI, i + 1, Length(URI));
-    URI := Copy(URI, 1, i - 1);
-  end;
-end;
-
-function THttpRequestHeader.GetFirstHeaderLine: String;
-begin
-  Result := Command + ' ' + URI;
-  if Length(HttpVersion) > 0 then
-    Result := Result + ' HTTP/' + HttpVersion;
-end;
-
-
-// -------------------------------------------------------------------
-//   THttpResponseHeader
-// -------------------------------------------------------------------
-
-procedure THttpResponseHeader.ParseFirstHeaderLine(const line: String);
-var
-  i: Integer;
-  s: String;
-begin
-  i := Pos('/', line);
-  s := Copy(line, i + 1, Length(line));
-  i := Pos(' ', s);
-  HttpVersion := Copy(s, 1, i - 1);
-  s := Copy(s, i + 1, Length(s));
-  i := Pos(' ', s);
-  if i > 0 then begin
-    CodeText := Copy(s, i + 1, Length(s));
-    s := Copy(s, 1, i - 1);
-  end;
-  Code := StrToInt(s);
-end;
-
-function THttpResponseHeader.GetFirstHeaderLine: String;
-begin
-  Result := Format('HTTP/%s %d %s', [HttpVersion, Code, CodeText]);
-end;
-
-constructor THttpResponseHeader.Create;
-begin
-  inherited Create;
-  Code := 200;
-  CodeText := 'OK';
-end;
-
-end.

packages/fcl-net/src/httpclient.pp

@@ -1,307 +0,0 @@
-{
-
-    HTTPClient: HTTP client component
-    Copyright (C) 2000-2003 by Sebastian Guenther ([email protected])
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-}
-
-
-unit HTTPClient;
-
-interface
-
-{$mode objfpc}
-{$H+}
-
-uses Classes, HTTPBase, fpSock, fpAsync;
-
-type
-
-  TCustomHTTPClient = class(TCustomTCPClient)
-  protected
-    SendBuffer: TAsyncWriteStream;
-    FOnPrepareSending: TNotifyEvent;
-    FOnHeaderSent: TNotifyEvent;
-    FOnStreamSent: TNotifyEvent;
-    FOnPrepareReceiving: TNotifyEvent;
-    FOnHeaderReceived: TNotifyEvent;
-    FOnStreamReceived: TNotifyEvent;
-    FOnDestroy: TNotifyEvent;
-    RecvSize: Integer;  // How many bytes are still to be read. -1 if unknown.
-    DataAvailableNotifyHandle: Pointer;
-    ReceivedHTTPVersion: String;
-
-    procedure HeaderToSendCompleted(Sender: TObject);
-    procedure StreamToSendCompleted(Sender: TObject);
-    procedure ReceivedHeaderCompleted(Sender: TObject);
-    procedure ReceivedHeaderEOF(Sender: TObject);
-    procedure DataAvailable(Sender: TObject);
-    procedure ReceivedStreamCompleted(Sender: TObject);
-
-    property OnPrepareSending: TNotifyEvent read FOnPrepareSending write FOnPrepareSending;
-    property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
-    property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
-    property OnPrepareReceiving: TNotifyEvent read FOnPrepareReceiving write FOnPrepareReceiving;
-    property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
-    property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
-    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
-
-  public
-    HeaderToSend: THttpHeader;
-    StreamToSend: TStream;
-    ReceivedHeader: THttpHeader;
-    ReceivedStream: TStream;
-    DoDestroy: Boolean;
-
-    destructor Destroy; override;
-    procedure Receive;
-    procedure Send;
-  end;
-
-  THttpClient = class(TCustomHttpClient)
-  public
-    property OnPrepareSending;
-    property OnHeaderSent;
-    property OnStreamSent;
-    property OnPrepareReceiving;
-    property OnHeaderReceived;
-    property OnStreamReceived;
-    property OnDestroy;
-  end;
-
-  {TCustomHTTPClient = class
-  protected
-    FEventLoop: TEventLoop;
-    FSocket: TInetSocket;
-    SendBuffer: TAsyncWriteStream;
-    FOnPrepareSending: TNotifyEvent;
-    FOnHeaderSent: TNotifyEvent;
-    FOnStreamSent: TNotifyEvent;
-    FOnPrepareReceiving: TNotifyEvent;
-    FOnHeaderReceived: TNotifyEvent;
-    FOnStreamReceived: TNotifyEvent;
-    FOnDestroy: TNotifyEvent;
-    RecvSize: Integer;  // How many bytes are still to be read. -1 if unknown.
-    DataAvailableNotifyHandle: Pointer;
-    ReceivedHTTPVersion: String;
-
-    procedure HeaderToSendCompleted(Sender: TObject);
-    procedure StreamToSendCompleted(Sender: TObject);
-    procedure ReceivedHeaderCompleted(Sender: TObject);
-    procedure ReceivedHeaderEOF(Sender: TObject);
-    procedure DataAvailable(Sender: TObject);
-    procedure ReceivedStreamCompleted(Sender: TObject);
-
-    property OnPrepareSending: TNotifyEvent read FOnPrepareSending write FOnPrepareSending;
-    property OnHeaderSent: TNotifyEvent read FOnHeaderSent write FOnHeaderSent;
-    property OnStreamSent: TNotifyEvent read FOnStreamSent write FOnStreamSent;
-    property OnPrepareReceiving: TNotifyEvent read FOnPrepareReceiving write FOnPrepareReceiving;
-    property OnHeaderReceived: TNotifyEvent read FOnHeaderReceived write FOnHeaderReceived;
-    property OnStreamReceived: TNotifyEvent read FOnStreamReceived write FOnStreamReceived;
-    property OnDestroy: TNotifyEvent read FOnDestroy write FOnDestroy;
-
-  public
-    HeaderToSend: THttpHeader;
-    StreamToSend: TStream;
-    ReceivedHeader: THttpHeader;
-    ReceivedStream: TStream;
-    DoDestroy: Boolean;
-
-    constructor Create(AEventLoop: TEventLoop; ASocket: TInetSocket);
-    destructor Destroy; override;
-    procedure Receive;
-    procedure Send;
-  end;}
-
-
-implementation
-
-uses SysUtils;
-
-procedure TCustomHttpClient.HeaderToSendCompleted(Sender: TObject);
-begin
-  // WriteLn('TCustomHttpClient.HeaderToSendCompleted');
-  if Assigned(FOnHeaderSent) then
-    FOnHeaderSent(Self);
-  if Assigned(StreamToSend) then
-  begin
-    SendBuffer := TAsyncWriteStream.Create(EventLoop, Stream);
-    SendBuffer.CopyFrom(StreamToSend, StreamToSend.Size);
-    SendBuffer.OnBufferSent := @StreamToSendCompleted;
-  end else
-  begin
-    StreamToSendCompleted(nil);
-    if DoDestroy then
-      Self.Free;
-  end;
-end;
-
-procedure TCustomHttpClient.StreamToSendCompleted(Sender: TObject);
-begin
-  // WriteLn('TCustomHttpClient.StreamToSendCompleted');
-  if Assigned(FOnStreamSent) then
-    FOnStreamSent(Self);
-  FreeAndNil(SendBuffer);
-  if DoDestroy then
-    Self.Free
-  else
-    Receive;
-end;
-
-procedure TCustomHttpClient.ReceivedHeaderCompleted(Sender: TObject);
-var
-  BytesInBuffer: Integer;
-  NeedMoreData: Boolean;
-begin
-  // WriteLn('TCustomHttpClient.ReceivedHeaderCompleted');
-  ReceivedHeader.DataReceived := False;
-  ReceivedHTTPVersion := ReceivedHeader.HttpVersion;
-  BytesInBuffer := ReceivedHeader.Reader.BytesInBuffer;
-  //WriteLn('BytesInBuffer: ', BytesInBuffer, ', Content length: ', ReceivedHeader.ContentLength);
-  if Assigned(FOnHeaderReceived) then
-    FOnHeaderReceived(Self);
-
-  RecvSize := ReceivedHeader.ContentLength;
-  if Assigned(ReceivedStream) then
-  begin
-    if BytesInBuffer = 0 then
-      NeedMoreData := True
-    else
-    begin
-      ReceivedStream.Write(ReceivedHeader.Reader.Buffer^, BytesInBuffer);
-      if RecvSize > 0 then
-        Dec(RecvSize, BytesInBuffer);
-      if BytesInBuffer = ReceivedHeader.ContentLength then
-        NeedMoreData := False
-      else
-        NeedMoreData := (not ReceivedHeader.InheritsFrom(THttpRequestHeader)) or
-          (THttpRequestHeader(ReceivedHeader).Command <> 'GET');
-    end;
-  end else
-    NeedMoreData := False;
-
-  if NeedMoreData then
-    DataAvailableNotifyHandle :=
-      EventLoop.SetDataAvailableNotify(Stream.Handle, @DataAvailable, Stream)
-  else
-    ReceivedStreamCompleted(nil);
-
-  if DoDestroy then
-    Self.Free;
-end;
-
-procedure TCustomHttpClient.ReceivedHeaderEOF(Sender: TObject);
-begin
-  Self.Free;
-end;
-
-procedure TCustomHttpClient.DataAvailable(Sender: TObject);
-var
-  FirstRun: Boolean;
-  ReadNow, BytesRead: Integer;
-  buf: array[0..1023] of Byte;
-begin
-  FirstRun := True;
-  while True do
-  begin
-    if RecvSize >= 0 then
-    begin
-      ReadNow := RecvSize;
-      if ReadNow > 1024 then
-        ReadNow := 1024;
-    end else
-      ReadNow := 1024;
-    BytesRead := Stream.Read(buf, ReadNow);
-    // WriteLn('TCustomHttpClient.DataAvailable: Read ', BytesRead, ' bytes; RecvSize=', RecvSize);
-    if BytesRead <= 0 then
-    begin
-      if FirstRun then
-        ReceivedStreamCompleted(nil);
-      break;
-    end;
-    FirstRun := False;
-    ReceivedStream.Write(buf, BytesRead);
-    if RecvSize > 0 then
-      Dec(RecvSize, BytesRead);
-    if RecvSize = 0 then
-    begin
-      ReceivedStreamCompleted(nil);
-      break;
-    end;
-  end;
-  if DoDestroy then
-    Self.Free;
-end;
-
-procedure TCustomHttpClient.ReceivedStreamCompleted(Sender: TObject);
-begin
-  // WriteLn('TCustomHttpClient.ReceivedStreamCompleted');
-  if Assigned(DataAvailableNotifyHandle) then
-  begin
-    EventLoop.ClearDataAvailableNotify(DataAvailableNotifyHandle);
-    DataAvailableNotifyHandle := nil;
-  end;
-  if Assigned(FOnStreamReceived) then
-    FOnStreamReceived(Self);
-  if DoDestroy then
-    Self.Free
-  else
-    Send;
-end;
-
-{constructor TCustomHttpClient.Create(AManager: TEventLoop; ASocket: TInetSocket);
-begin
-  inherited Create;
-  EventLoop := AManager;
-  Stream := ASocket;
-end;}
-
-destructor TCustomHttpClient.Destroy;
-begin
-  if Assigned(DataAvailableNotifyHandle) then
-    EventLoop.ClearDataAvailableNotify(DataAvailableNotifyHandle);
-  if Assigned(OnDestroy) then
-    OnDestroy(Self);
-  FreeAndNil(SendBuffer);
-  inherited Destroy;
-end;
-
-procedure TCustomHttpClient.Receive;
-begin
-  // Start receiver
-  ReceivedHttpVersion := '';
-  if Assigned(OnPrepareReceiving) then
-    OnPrepareReceiving(Self);
-  if Assigned(ReceivedHeader) then
-  begin
-    ReceivedHeader.OnCompleted := @ReceivedHeaderCompleted;
-    ReceivedHeader.OnEOF := @ReceivedHeaderEOF;
-    ReceivedHeader.AsyncReceive(EventLoop, Stream);
-  end;
-end;
-
-procedure TCustomHttpClient.Send;
-begin
-  // Start sender
-  if Assigned(OnPrepareSending) then
-    OnPrepareSending(Self);
-  if Assigned(HeaderToSend) then
-  begin
-    if ReceivedHttpVersion <> '' then
-    begin
-      HeaderToSend.HttpVersion := ReceivedHttpVersion;
-      ReceivedHttpVersion := '';
-    end;
-    HeaderToSend.OnCompleted := @HeaderToSendCompleted;
-    HeaderToSend.AsyncSend(EventLoop, Stream);
-  end;
-end;
-
-
-end.

packages/fcl-net/src/mkxmlrpc.pp

@@ -1,871 +0,0 @@
-{
-
-    Automatic XML-RPC wrapper generator
-    Copyright (c) 2003 by
-      Areca Systems GmbH / Sebastian Guenther, [email protected]
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-}
-program MkXMLRPC;
-
-{$mode objfpc}
-{$H+}
-
-uses SysUtils, Classes, PParser, PasTree, PasWrite;
-
-resourcestring
-  SCmdLineInvalidOption = 'Ignoring unknown option "%s"';
-  SNoServerClassNameProvided =
-    'No server class name provided (use --serverclass=<name>)';
-  SNoUnitNameProvided =
-    'No name for generated unit provided (use --unitname=<name>)';
-
-type
-  TParserEngine = class(TPasTreeContainer)
-  protected
-    Modules, UsedModules: TList;
-    CurModule: TPasModule;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    function CreateElement(AClass: TPTreeElement; const AName: String;
-      AParent: TPasElement; AVisibility: TPasMemberVisibility;
-      const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
-      override;
-    function FindElement(const AName: String): TPasElement; override;
-    function FindModule(const AName: String): TPasModule; override;
-  end;
-
-  TServerClass = class
-    Element: TPasClassType;
-    ImplName: String;
-  end;
-
-  TRPCList = class
-    ServerClasses: TList;
-    UsedModules: TStringList;
-    constructor Create;
-    destructor Destroy; override;
-    procedure AddServerClass(const AClassName: String);
-  end;
-
-var
-  Engine: TParserEngine;
-
-
-constructor TParserEngine.Create;
-begin
-  inherited Create;
-  Modules := TList.Create;
-  UsedModules := TList.Create;
-end;
-
-destructor TParserEngine.Destroy;
-begin
-  UsedModules.Free;
-  Modules.Free;
-  inherited Destroy;
-end;
-
-function TParserEngine.CreateElement(AClass: TPTreeElement; const AName: String;
-  AParent: TPasElement; AVisibility: TPasMemberVisibility;
-  const ASourceFilename: String; ASourceLinenumber: Integer): TPasElement;
-begin
-  Result := AClass.Create(AName, AParent);
-  Result.Visibility := AVisibility;
-  if AClass.InheritsFrom(TPasModule) then
-  begin
-    Modules.Add(Result);
-    CurModule := TPasModule(Result);
-  end;
-end;
-
-function TParserEngine.FindElement(const AName: String): TPasElement;
-
-  function FindInModule(AModule: TPasModule; const LocalName: String): TPasElement;
-  var
-    l: TList;
-    i, j: Integer;
-    Found: Boolean;
-  begin
-    l := AModule.InterfaceSection.Declarations;
-    for i := 0 to l.Count - 1 do
-    begin
-      Result := TPasElement(l[i]);
-      if CompareText(Result.Name, LocalName) = 0 then
-      begin
-        Found := False;
-        for j := 0 to UsedModules.Count - 1 do
-          if CompareText(TPasModule(UsedModules[j]).Name, AModule.Name) = 0 then
-          begin
-            Found := True;
-            break;
-          end;
-        if not Found then
-          UsedModules.Add(AModule);
-        exit;
-      end;
-    end;
-    Result := nil;
- end;
-
-var
-  i: Integer;
-  //ModuleName, LocalName: String;
-  Module: TPasElement;
-begin
-{!!!: Don't know if we ever will have to use the following:
-  i := Pos('.', AName);
-  if i <> 0 then
-  begin
-    WriteLn('Dot found in name: ', AName);
-    Result := nil;
-  end else
-  begin}
-    Result := FindInModule(CurModule, AName);
-    if not Assigned(Result) then
-      for i := CurModule.InterfaceSection.UsesList.Count - 1 downto 0 do
-      begin
-        Module := TPasElement(CurModule.InterfaceSection.UsesList[i]);
-        if Module.ClassType = TPasModule then
-        begin
-          Result := FindInModule(TPasModule(Module), AName);
-          if Assigned(Result) then
-            exit;
-        end;
-      end;
-  {end;}
-end;
-
-function TParserEngine.FindModule(const AName: String): TPasModule;
-var
-  i: Integer;
-begin
-  for i := Modules.Count - 1 downto 0 do
-  begin
-    Result := TPasModule(Modules[i]);
-    if CompareText(Result.Name, AName) = 0 then
-      exit;
-  end;
-  Result := nil;
-end;
-
-
-constructor TRPCList.Create;
-begin
-  ServerClasses := TList.Create;
-  UsedModules := TStringList.Create;
-end;
-
-destructor TRPCList.Destroy;
-var
-  i: Integer;
-begin
-  UsedModules.Free;
-  for i := 0 to ServerClasses.Count - 1 do
-    TServerClass(ServerClasses[i]).Free;
-  ServerClasses.Free;
-end;
-
-procedure TRPCList.AddServerClass(const AClassName: String);
-var
-  Element: TPasClassType;
-  ServerClass: TServerClass;
-begin
-  Element := TPasClassType(Engine.FindElement(AClassName));
-  if not Assigned(Element) then
-  begin
-    WriteLn(StdErr, 'Server class "', AClassName, '" not found!');
-    Halt(3);
-  end;
-  if (not Element.InheritsFrom(TPasClassType)) or
-    (Element.ObjKind <> okClass) then
-  begin
-    WriteLn('"', AClassName, '" is not a class!');
-    Halt(4);
-  end;
-  ServerClass := TServerClass.Create;
-  ServerClasses.Add(ServerClass);
-  ServerClass.Element := Element;
-  ServerClass.ImplName := Copy(Element.Name, 2, Length(Element.Name));
-  UsedModules.Add(Element.GetModule.Name);
-end;
-
-
-var
-  OutputFilename, UnitName: String;
-  RPCList: TRPCList;
-
-procedure WriteClassServerSource(ServerClass: TPasClassType;
-  ImplementationSection: TPasSection; Method, ProcImpl: TPasProcedureImpl;
-  const MethodPrefix: String; NestingLevel: Integer);
-
-{ Method: Main server method
-  ProcImpl: Current procedure (may be identical with Method) }
-
-type
-  TConversionInfo = record
-    ConverterName, TypecastFunction: String;
-    ArgIsParent: Boolean;
-  end;
-
-  function MakeStructConverter(AClass: TPasClassType;
-    Referrer: TPasProcedureImpl): TPasProcedureImpl; forward;
-
-  function MakeArrayConverter(Member, ArraySizeProp: TPasProperty;
-    ProcessProc, Referrer: TPasProcedureImpl): TPasProcedureImpl; forward;
-
-  function FindArraySizeProperty(AArrayProp: TPasProperty): TPasProperty;
-  var
-    i: Integer;
-    Name: String;
-  begin
-    Name := Copy(AArrayProp.Name, 1, Length(AArrayProp.Name) - 1) + 'Count';
-    for i := 0 to TPasClassType(AArrayProp.Parent).Members.Count - 1 do
-    begin
-      Result := TPasProperty(TPasClassType(AArrayProp.Parent).Members[i]);
-      if (Result.ClassType = TPasProperty) and (Result.Visibility = visPublic)
-        and (CompareStr(Result.Name, Name) = 0) then
-        exit;
-    end;
-
-    Name := AArrayProp.Name + 'Count';
-    for i := 0 to TPasClassType(AArrayProp.Parent).Members.Count - 1 do
-    begin
-      Result := TPasProperty(TPasClassType(AArrayProp.Parent).Members[i]);
-      if (Result.ClassType = TPasProperty) and (Result.Visibility = visPublic)
-        and (CompareStr(Result.Name, Name) = 0) then
-        exit;
-    end;
-    Result := nil;
-  end;
-
-  function GetConversionInfo(Element: TPasElement;
-    Referrer: TPasProcedureImpl): TConversionInfo;
-  var
-    s: String;
-    ArraySizeProp: TPasProperty;
-  begin
-    FillChar(Result, SizeOf(Result), 0);
-    Result.ArgIsParent := False;
-
-    if Element.ClassType = TPasProperty then
-    begin
-      ArraySizeProp := FindArraySizeProperty(TPasProperty(Element));
-      if Assigned(ArraySizeProp) then
-      begin
-        Result.ConverterName := MakeArrayConverter(TPasProperty(Element),
-          ArraySizeProp, ProcImpl, Referrer).Name;
-        Result.ArgIsParent := True;
-        exit;
-      end else
-        Element := TPasProperty(Element).VarType;
-    end;
-
-    if Element.ClassType = TPasUnresolvedTypeRef then
-    begin
-      s := UpperCase(Element.Name);
-      if (s = 'BYTE') or (s = 'SHORTINT') or (S = 'SMALLINT') or
-        (s = 'INTEGER') or (s = 'LONGINT') or (s = 'CARDINAL') or
-        (s = 'INT64') or (s = 'QUADWORD') then
-        Result.ConverterName := 'AWriter.CreateIntValue'
-      else if (s = 'BOOLEAN') or (s = 'WORDBOOL') or (s = 'LONGBOOL') then
-        Result.ConverterName := 'AWriter.CreateBooleanValue'
-      else if s = 'STRING' then
-        Result.ConverterName := 'AWriter.CreateStringValue'
-      else if (s = 'FLOAT') or (s = 'SINGLE') or (s = 'DOUBLE') or
-        (s = 'EXTENDED') then
-        Result.ConverterName := 'AWriter.CreateDoubleValue'
-      else if s = 'TDATETIME' then
-        Result.ConverterName := 'AWriter.CreateDateTimeValue';
-    end else if Element.ClassType = TPasClassType then
-      Result.ConverterName := MakeStructConverter(TPasClassType(Element), Referrer).Name
-    else if Element.ClassType = TPasEnumType then
-    begin
-      Result.ConverterName := 'AWriter.CreateIntValue';
-      Result.TypecastFunction := 'Ord';
-    end;
-
-    if Length(Result.ConverterName) = 0 then
-      raise Exception.Create('Result type not supported: ' + Element.ClassName +
-        ' ' + Element.Name);
-  end;
-
-  function MakeAccessor(ConversionInfo: TConversionInfo;
-    const DataSource, ArrayIndex: String): String;
-  begin
-    Result := ConversionInfo.ConverterName + '(';
-    if ConversionInfo.TypecastFunction <> '' then
-      Result := Result + ConversionInfo.TypecastFunction + '(';
-    Result := Result + DataSource;
-    if ConversionInfo.TypecastFunction <> '' then
-      Result := Result + ')';
-    if ArrayIndex <> '' then
-      Result := Result + '[' + ArrayIndex + ']';
-    Result := Result + ')';
-  end;
-
-  function GetParseValueFnName(PasType: TPasElement): String;
-  var
-    s: String;
-  begin
-    SetLength(Result, 0);
-    if PasType.ClassType = TPasArgument then
-    begin
-      if TPasArgument(PasType).Access = argVar then
-        raise Exception.Create('"var" arguments are not allowed');
-      PasType := TPasArgument(PasType).ArgType;
-    end;
-
-    if PasType.ClassType = TPasUnresolvedTypeRef then
-    begin
-      s := UpperCase(PasType.Name);
-      if (s = 'BYTE') or (s = 'SHORTINT') or (S = 'SMALLINT') or
-        (s = 'INTEGER') or (s = 'LONGINT') or (s = 'CARDINAL') or
-        (s = 'INT64') or (s = 'QUADWORD') then
-        Result := 'Int'
-      else if (s = 'BOOLEAN') or (s = 'WORDBOOL') or (s = 'LONGBOOL') then
-        Result := 'Boolean'
-      else if s = 'STRING' then
-        Result := 'String'
-      else if (s = 'FLOAT') or (s = 'SINGLE') or (s = 'DOUBLE') or
-        (s = 'EXTENDED') then
-        Result := 'Double'
-      else if s = 'TDATETIME' then
-        Result := 'DateTime';
-    end;
-    if Length(Result) = 0 then
-      raise Exception.Create('Argument type not supported: ' +
-        PasType.ClassName + ' ' + PasType.Name);
-  end;
-
-  function NeedLocalProc(const ProcName: String;
-    Referrer: TPasProcedureImpl): TPasProcedureImpl;
-  var
-    i, j: Integer;
-  begin
-    for i := 0 to Method.Locals.Count - 1 do
-    begin
-      Result := TPasProcedureImpl(Method.Locals[i]);
-      if Result.Name = ProcName then
-      begin
-        j := Method.Locals.IndexOf(Referrer);
-        if (j >= 0) and (i >= j) then
-        begin
-          // Move existing converter to the top and exit
-          Method.Locals.Delete(i);
-          j := Method.Locals.IndexOf(ProcImpl);
-          if j < 0 then
-            j := 0;
-          Method.Locals.Insert(j, Result);
-        end;
-        exit;
-      end;
-    end;
-    Result := nil;
-  end;
-
-  function MakeStructConverter(AClass: TPasClassType;
-    Referrer: TPasProcedureImpl): TPasProcedureImpl;
-  var
-    ConverterName, s: String;
-    Commands: TPasImplCommands;
-    i: Integer;
-    LocalMember: TPasElement;
-    ConversionInfo: TConversionInfo;
-  begin
-    ConverterName := 'Convert' + AClass.Name;
-    Result := NeedLocalProc(ConverterName, Referrer);
-    if Assigned(Result) then
-      exit;
-
-    Result := TPasProcedureImpl.Create(ConverterName, Method);
-    i := Method.Locals.IndexOf(Referrer);
-    if i < 0 then
-      i := 0;
-    Method.Locals.Insert(i, Result);
-    Result.ProcType := TPasFunctionType.Create('', Result);
-    Result.ProcType.CreateArgument('Inst', AClass.Name);
-    TPasFunctionType(Result.ProcType).ResultEl :=
-      TPasResultElement.Create('', Result);
-    TPasFunctionType(Result.ProcType).ResultEl.ResultType :=
-      TPasUnresolvedTypeRef.Create('TXMLRPCStruct', Result);
-
-    Result.Body := TPasImplBlock.Create('', Result);
-    Commands := Result.Body.AddCommands;
-    Commands.Commands.Add('Result := AWriter.CreateStruct');
-    for i := 0 to AClass.Members.Count - 1 do
-    begin
-      LocalMember := TPasElement(AClass.Members[i]);
-      if LocalMember.ClassType = TPasProperty then
-      begin
-        ConversionInfo := GetConversionInfo(LocalMember, Result);
-        if ConversionInfo.ArgIsParent then
-          s := 'Inst'
-        else
-          s := 'Inst.' + LocalMember.Name;
-        s := 'AWriter.AddStructMember(Result, ''' + LocalMember.Name + ''', ' +
-          MakeAccessor(ConversionInfo, s, '') + ')';
-        Commands.Commands.Add(s);
-      end;
-    end;
-  end;
-
-  function MakeArrayConverter(Member, ArraySizeProp: TPasProperty;
-    ProcessProc, Referrer: TPasProcedureImpl): TPasProcedureImpl;
-  var
-    i: Integer;
-    ConverterName, s: String;
-    Commands: TPasImplCommands;
-    VarMember: TPasVariable;
-    ForLoop: TPasImplForLoop;
-    ConversionInfo: TConversionInfo;
-  begin
-    ConverterName := 'Convert' + Member.Parent.Name + '_' + Member.Name;
-    Result := NeedLocalProc(ConverterName, Referrer);
-    if Assigned(Result) then
-      exit;
-
-    Result := TPasProcedureImpl.Create(ConverterName, Method);
-    i := Method.Locals.IndexOf(Referrer);
-    if i < 0 then
-      i := 0;
-    Method.Locals.Insert(i, Result);
-    Result.ProcType := TPasFunctionType.Create('', Result);
-    Result.ProcType.CreateArgument('Inst', Member.Parent.Name);
-    TPasFunctionType(Result.ProcType).ResultEl :=
-      TPasResultElement.Create('', Result);
-    TPasFunctionType(Result.ProcType).ResultEl.ResultType :=
-      TPasUnresolvedTypeRef.Create('TXMLRPCArray', Result);
-
-    Result.Body := TPasImplBlock.Create('', Result);
-    Commands := Result.Body.AddCommands;
-    Commands.Commands.Add('Result := AWriter.CreateArray');
-
-    VarMember := TPasVariable.Create('i', Result);
-    Result.Locals.Add(VarMember);
-    VarMember.VarType := TPasUnresolvedTypeRef.Create('Integer', VarMember);
-
-    ForLoop := Result.Body.AddForLoop(TPasVariable.Create('i', Result),
-      '0', MethodPrefix + ArraySizeProp.Name + ' - 1');
-    ForLoop.Body := TPasImplCommand.Create('', ForLoop);
-    ConversionInfo := GetConversionInfo(Member.VarType, Result);
-    if ConversionInfo.ArgIsParent then
-      s := 'Inst'
-    else
-      s := 'Inst.' + Member.Name + '[i]';
-    s := 'AWriter.AddArrayElement(Result, ' +
-      MakeAccessor(ConversionInfo, s, '') + ')';
-    TPasImplCommand(ForLoop.Body).Command := s;
-  end;
-
-  function CreateDispatcher(VarType: TPasClassType;
-    Referrer: TPasProcedureImpl): TPasProcedureImpl;
-  var
-    DispatcherName: String;
-  begin
-    DispatcherName := 'Dispatch' + VarType.Name;
-    Result := NeedLocalProc(DispatcherName, Referrer);
-    if Assigned(Result) then
-      exit;
-
-    // Create new dispatcher method
-    Result := TPasProcedureImpl.Create(DispatcherName, Method);
-    if ProcImpl = Method then
-      Method.Locals.Insert(0, Result)
-    else
-      Method.Locals.Insert(Method.Locals.IndexOf(Referrer), Result);
-    Result.ProcType := TPasProcedureType.Create('', Result);
-    Result.ProcType.CreateArgument('Inst', VarType.Name);
-    Result.ProcType.CreateArgument('Level', 'Integer');
-    WriteClassServerSource(VarType,
-      ImplementationSection, Method, Result, 'Inst.', NestingLevel + 1);
-  end;
-
-
-var
-  IfElse, ParentIfElse: TPasImplIfElse;
-
-  procedure CreateBranch(const MethodName: String);
-  begin
-    if Assigned(ParentIfElse) then
-    begin
-      IfElse := TPasImplIfElse.Create('', ParentIfElse);
-      ParentIfElse.ElseBranch := IfElse;
-    end else
-    begin
-      IfElse := TPasImplIfElse.Create('', ProcImpl.Body);
-      ProcImpl.Body.Elements.Add(IfElse);
-    end;
-    ParentIfElse := IfElse;
-    IfElse.Condition := 's = ''' + UpperCase(MethodName) + '''';
-  end;
-
-  procedure ProcessMethodCall(Member: TPasProcedure);
-
-    function MakeProcArgs(Args: TList): String;
-    var
-      i: Integer;
-    begin
-      if (not Assigned(Args)) or (Args.Count = 0) then
-        Result := ''
-      else
-      begin
-        Result := '(';
-        for i := 0 to Args.Count - 1 do
-        begin
-          if i > 0 then
-            Result := Result + ', ';
-          Result := Result + 'AParser.GetPrev' + GetParseValueFnName(TPasType(Args[i]));
-        end;
-        Result := Result + ')';
-      end;
-    end;
-
-  var
-    Commands: TPasImplCommands;
-    s: String;
-  begin
-    CreateBranch(Member.Name);
-    Commands := TPasImplCommands.Create('', IfElse);
-    IfElse.IfBranch := Commands;
-
-    if TPasProcedure(Member).ProcType.Args.Count > 0 then
-      Commands.Commands.Add('AParser.ResetValueCursor');
-    if Member.ClassType = TPasProcedure then
-    begin
-      Commands.Commands.Add(MethodPrefix + Member.Name +
-        MakeProcArgs(TPasProcedure(Member).ProcType.Args));
-      Commands.Commands.Add('AWriter.WriteResponse(nil)');
-    end else
-    begin
-      // function
-      s := MethodPrefix + Member.Name +
-        MakeProcArgs(TPasProcedure(Member).ProcType.Args);
-      Commands.Commands.Add('AWriter.WriteResponse(' +
-        MakeAccessor(GetConversionInfo(TPasFunctionType(TPasFunction(Member).
-          ProcType).ResultEl.ResultType, ProcImpl), s, '') + ')');
-    end;
-  end;
-
-  procedure ProcessProperty(Member: TPasProperty);
-  var
-    LocalIfElse: TPasImplIfElse;
-    IsArray, IsStruct: Boolean;
-    s, s2: String;
-    Commands: TPasImplCommands;
-    Command: TPasImplCommand;
-    ConversionInfo: TConversionInfo;
-  begin
-    if Member.ReadAccessorName <> '' then
-    begin
-      CreateBranch('Get' + Member.Name);
-
-      IsArray := (Member.Args.Count = 1) and
-        Assigned(FindArraySizeProperty(Member));
-      IsStruct := Member.VarType.ClassType = TPasClassType;
-
-      if IsStruct then
-        s := CreateDispatcher(TPasClassType(Member.VarType), ProcImpl).Name +
-          '(' + MethodPrefix + Member.Name;
-
-      if NestingLevel = 0 then
-        s2 := '1'
-      else
-        s2 := 'Level + 1';
-
-      if IsArray or (IsStruct and (Member.Args.Count = 0)) then
-      begin
-        LocalIfElse := TPasImplIfElse.Create('', IfElse);
-        IfElse.IfBranch := LocalIfElse;
-        LocalIfElse.Condition := 'APath.Count <= ' + s2;
-      end;
-
-      if IsStruct then
-        if IsArray then
-        begin
-          LocalIfElse.IfBranch := TPasImplCommand.Create('', LocalIfElse);
-          TPasImplCommand(LocalIfElse.IfBranch).Command :=
-            'AWriter.WriteResponse(' +
-            MakeAccessor(GetConversionInfo(Member, ProcImpl),
-              Copy(MethodPrefix, 1, Length(MethodPrefix) - 1), '') + ')';
-
-          LocalIfElse.ElseBranch := TPasImplCommand.Create('', LocalIfElse);
-          TPasImplCommand(LocalIfElse.ElseBranch).Command :=
-            s + '[AParser.GetNext' +
-            GetParseValueFnName(TPasArgument(Member.Args[0]).ArgType) + '], ' +
-            s2 + ')';
-        end else
-        begin
-          if Member.Args.Count = 0 then
-          begin
-            LocalIfElse.IfBranch := TPasImplCommand.Create('', LocalIfElse);
-            TPasImplCommand(LocalIfElse.IfBranch).Command :=
-               'AWriter.WriteResponse(' +
-               MakeAccessor(GetConversionInfo(Member, ProcImpl),
-                 MethodPrefix + Member.Name, '') + ')';
-            LocalIfElse.ElseBranch := TPasImplCommand.Create('', LocalIfElse);
-            TPasImplCommand(LocalIfElse.ElseBranch).Command := s + ', ' + s2 + ')';
-          end else
-          begin
-            IfElse.IfBranch := TPasImplCommand.Create('', IfElse);
-            TPasImplCommand(IfElse.IfBranch).Command := s + '[AParser.GetNext' +
-            GetParseValueFnName(TPasArgument(Member.Args[0]).ArgType) + '], ' +
-            s2 + ')';
-          end;
-        end
-      else if IsArray then
-      begin
-        LocalIfElse.IfBranch := TPasImplCommand.Create('', LocalIfElse);
-        TPasImplCommand(LocalIfElse.IfBranch).Command :=
-           'AWriter.WriteResponse(' +
-           MakeAccessor(GetConversionInfo(Member, ProcImpl),
-             Copy(MethodPrefix, 1, Length(MethodPrefix) - 1), '') + ')';
-
-        LocalIfElse.ElseBranch := TPasImplCommand.Create('', LocalIfElse);
-        TPasImplCommand(LocalIfElse.ElseBranch).Command :=
-          'AWriter.WriteResponse(' +
-          MakeAccessor(GetConversionInfo(Member.VarType, ProcImpl),
-            MethodPrefix + Member.Name, 'AParser.GetNext' +
-            GetParseValueFnName(TPasArgument(Member.Args[0]).ArgType)) + ')';
-      end else
-      begin
-        IfElse.IfBranch := TPasImplCommand.Create('', IfElse);
-        TPasImplCommand(IfElse.IfBranch).Command := 'AWriter.WriteResponse(' +
-          MakeAccessor(GetConversionInfo(Member.VarType, ProcImpl),
-            MethodPrefix + Member.Name, '') + ')';
-      end;
-    end;
-
-    if Member.WriteAccessorName <> '' then
-    begin
-      CreateBranch('Set' + Member.Name);
-      Commands := TPasImplCommands.Create('', IfElse);
-      IfElse.IfBranch := Commands;
-      Commands.Commands.Add('// Not supported by mkxmlrpc yet');
-    end;
-  end;
-
-var
-  VarMember: TPasVariable;
-  i: Integer;
-  Command: TPasImplCommand;
-  Member: TPasElement;
-begin
-  VarMember := TPasVariable.Create('s', ProcImpl);
-  ProcImpl.Locals.Add(VarMember);
-  VarMember.VarType := TPasUnresolvedTypeRef.Create('String', VarMember);
-  ProcImpl.Body := TPasImplBlock.Create('', ProcImpl);
-  if NestingLevel = 0 then
-    ProcImpl.Body.AddCommand('s := APath[' + IntToStr(NestingLevel) + ']')
-  else
-    ProcImpl.Body.AddCommand('s := APath[Level]');
-  ParentIfElse := nil;
-  for i := 0 to ServerClass.Members.Count - 1 do
-  begin
-    Member := TPasElement(ServerClass.Members[i]);
-    if Member.Visibility <> visPublic then
-      continue;
-
-    if (Member.ClassType = TPasProcedure) or (Member.ClassType = TPasFunction)
-    then
-      ProcessMethodCall(TPasProcedure(Member))
-    else if Member.ClassType = TPasProperty then
-      ProcessProperty(TPasProperty(Member))
-    else if (Member.ClassType <> TPasConstructor) and
-      (Member.ClassType <> TPasDestructor) then
-      WriteLn('Warning: Unsupportet member type: ', Member.ElementTypeName);
-  end;
-
-  if Assigned(ParentIfElse) then
-  begin
-    Command := TPasImplCommand.Create('', ParentIfElse);
-    ParentIfElse.ElseBranch := Command;
-  end else
-  begin
-    Command := TPasImplCommand.Create('', ProcImpl.Body);
-    ProcImpl.Body.Elements.Add(Command);
-  end;
-  Command.Command := 'AWriter.WriteFaultResponse(2, ''Invalid method name'')';
-end;
-
-procedure WriteFPCServerSource;
-var
-  i, j: Integer;
-  Module: TPasModule;
-  InterfaceSection:TInterfaceSection;
-   ImplementationSection: TImplementationSection;
-  VarMember: TPasVariable;
-  PropertyMember: TPasProperty;
-  ProcMember: TPasProcedure;
-  Arg: TPasArgument;
-  ServerClass: TPasClassType;
-  Stream: TStream;
-  ProcImpl: TPasProcedureImpl;
-  Found: Boolean;
-begin
-  Module := TPasModule.Create(UnitName, nil);
-  try
-    InterfaceSection := TInterfaceSection.Create('', Module);
-    Module.InterfaceSection := InterfaceSection;
-    ImplementationSection := TImplementationSection.Create('', Module);
-    Module.ImplementationSection := ImplementationSection;
-    InterfaceSection.AddUnitToUsesList('Classes');
-    InterfaceSection.AddUnitToUsesList('XMLRPC');
-    for i := 0 to RPCList.UsedModules.Count - 1 do
-      InterfaceSection.AddUnitToUsesList(RPCList.UsedModules[i]);
-
-    for i := 0 to RPCList.ServerClasses.Count - 1 do
-      with TServerClass(RPCList.ServerClasses[i]) do
-      begin
-        ServerClass := TPasClassType.Create('T' + ImplName + 'XMLRPCServlet',
-          InterfaceSection);
-        InterfaceSection.Declarations.Add(ServerClass);
-        ServerClass.ObjKind := okClass;
-        ServerClass.AncestorType :=
-          TPasUnresolvedTypeRef.Create('TXMLRPCServlet', ServerClass);
-
-        // Create private field which holds the implementation instance
-        VarMember := TPasVariable.Create('F' + ImplName, ServerClass);
-        VarMember.Visibility := visPrivate;
-        VarMember.VarType := TPasUnresolvedTypeRef.Create(Element.Name, VarMember);
-        ServerClass.Members.Add(VarMember);
-
-        // Create dispatcher method
-        ProcMember := TPasProcedure.Create('Dispatch', ServerClass);
-        ProcMember.Visibility := visProtected;
-        ProcMember.AddModifier(pmOverride);
-        ProcMember.ProcType := TPasProcedureType.Create('', ProcMember);
-        ProcMember.ProcType.CreateArgument('AParser', 'TXMLRPCParser').
-          Visibility := visPublic;
-        ProcMember.ProcType.CreateArgument('AWriter', 'TXMLRPCWriter').
-          Visibility := visPublic;
-        ProcMember.ProcType.CreateArgument('APath', 'TStrings').
-          Visibility := visPublic;
-        ServerClass.Members.Add(ProcMember);
-
-        // Create published property for implementation instance
-        PropertyMember := TPasProperty.Create(ImplName, ServerClass);
-        PropertyMember.Visibility := visPublished;
-        PropertyMember.VarType := VarMember.VarType;
-        VarMember.VarType.AddRef;
-        PropertyMember.ReadAccessorName := 'F' + ImplName;
-        PropertyMember.WriteAccessorName := 'F' + ImplName;
-        ServerClass.Members.Add(PropertyMember);
-
-        // Create dispatcher implementation
-        ProcImpl := TPasProcedureImpl.Create('Dispatch', ServerClass);
-        ImplementationSection.Declarations.Add(ProcImpl);
-        ProcImpl.ProcType := ProcMember.ProcType;
-        ProcMember.ProcType.AddRef;
-        ProcImpl.ProcType.AddRef;
-        WriteClassServerSource(Element, ImplementationSection, ProcImpl,
-          ProcImpl, ImplName + '.', 0);
-      end;
-
-    for i := 0 to Engine.UsedModules.Count - 1 do
-    begin
-      Found := False;
-      for j := 0 to RPCList.UsedModules.Count - 1 do
-        if CompareText(RPCList.UsedModules[j],
-          TPasModule(Engine.UsedModules[i]).Name) = 0 then
-        begin
-          Found := True;
-          break;
-        end;
-      if not Found then
-        ImplementationSection.AddUnitToUsesList(
-          TPasModule(Engine.UsedModules[i]).Name);
-    end;
-
-    Stream := THandleStream.Create(StdOutputHandle);
-    try
-      WritePasFile(Module, Stream);
-    finally
-      Stream.Free;
-    end;
-
-    Stream := TFileStream.Create(OutputFilename, fmCreate);
-    try
-      WritePasFile(Module, Stream);
-    finally
-      Stream.Free;
-    end;
-  finally
-    Module.Free;
-  end;
-end;
-
-
-var
-  i, j: Integer;
-  s, Cmd, Arg: String;
-  InputFiles, ClassList: TStringList;
-begin
-  InputFiles := TStringList.Create;
-  ClassList := TStringList.Create;
-  try
-    for i := 1 to ParamCount do
-    begin
-      s := ParamStr(i);
-      j := Pos('=', s);
-      if j > 0 then
-      begin
-        Cmd := Copy(s, 1, j - 1);
-        Arg := Copy(s, j + 1, Length(s));
-      end else
-      begin
-        Cmd := s;
-        SetLength(Arg, 0);
-      end;
-      if (Cmd = '-i') or (Cmd = '--input') then
-        InputFiles.Add(Arg)
-      else if Cmd = '--output' then
-        OutputFilename := Arg
-      else if Cmd = '--unitname' then
-        UnitName := Arg
-      else if Cmd = '--serverclass' then
-        ClassList.Add(Arg)
-      else
-        WriteLn(StdErr, Format(SCmdLineInvalidOption, [s]));
-    end;
-
-    if ClassList.Count = 0 then
-    begin
-      WriteLn(StdErr, SNoServerClassNameProvided);
-      Halt(2);
-    end;
-
-    if UnitName = '' then
-    begin
-      WriteLn(StdErr, SNoUnitNameProvided);
-      Halt(2);
-    end;
-
-    Engine := TParserEngine.Create;
-    try
-      // Engine.SetPackageName('XMLRPC');
-      for i := 0 to InputFiles.Count - 1 do
-        ParseSource(Engine, InputFiles[i], '', '');
-
-      RPCList := TRPCList.Create;
-      try
-        for i := 0 to ClassList.Count - 1 do
-          RPCList.AddServerClass(ClassList[i]);
-        WriteFPCServerSource;
-      finally
-        RPCList.Free;
-      end;
-    finally
-      Engine.Free;
-    end;
-  finally
-    InputFiles.Free;
-    ClassList.Free;
-  end;
-end.

packages/fcl-net/src/servlets.pp

@@ -1,114 +0,0 @@
-{
-
-    Basic Servlet Support
-    Copyright (c) 2003 by
-      Areca Systems GmbH / Sebastian Guenther, [email protected]
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-}
-{$mode objfpc}{$H+}
-unit Servlets;
-
-interface
-
-uses SysUtils, Classes;
-
-type
-
-  EServlet = class(Exception);
-
-  TServletContext = class
-  public
-    property Attributes[const AName: String]: TObject;  // !!!: Implement this  rw
-    // function GetContext(const URIPath: String): TServletContext;     // !!!: How to implement?
-    // function GetRealPath(const APath: String): String;       // !!!: How to implement?
-    property ServletContextName: String;        // !!!: How to implement?
-    // procedure Log(const AMsg: String);       // !!!: Implement this
-    // procedure RemoveAttribute(const AName: String);  // !!!: Implement this
-  end;
-
-  TServletRequest = class
-  private
-    FInputStream: TStream;
-    FScheme: String;
-  protected
-    FPathInfo: String;
-
-    function GetContentLength: Integer; virtual; abstract;
-    function GetContentType: String; virtual; abstract;
-    function GetProtocol: String; virtual; abstract;
-  public
-    constructor Create(AInputStream: TStream; const AScheme, APathInfo: String);
-    property Attributes[const AName: String]: TObject;  // !!!: Implement this  rw
-    property CharacterEncoding: String; // !!!: Implement this  rw
-    property ContentLength: Integer read GetContentLength;
-    property ContentType: String read GetContentType;
-    property InputStream: TStream read FInputStream;
-    property Parameters[const AName: String]: String;   // !!!: Implement this
-    property ParameterValues[const AName: String]: TStrings;    // !!!: Implement this
-    property Protocol: String read GetProtocol;
-    property RemoteAddr: String;        // !!!: Implement this
-    property RemoteHost: String;        // !!!: Implement this
-    property Scheme: String read FScheme;
-    property ServerName: String;        // !!!: How to implement?
-    property ServerPort: Integer;       // !!!: How to implement?
-    property IsSecure: Boolean;         // !!!: Implement this
-
-    // procedure RemoveAttribute(const AName: String);  // !!!: Implement this
-  end;
-
-  TServletResponse = class
-  private
-    FOutputStream: TStream;
-  protected
-    procedure SetContentType(const Value: String); virtual; abstract;
-    procedure SetContentLength(Value: Int64); virtual; abstract;
-  public
-    constructor Create(AOutputStream: TStream);
-    property BufferSize: Integer;       // !!!: How to implement?  rw
-    property CharacterEncoding: String; // !!!: Implement this
-    property ContentLength: Int64 write SetContentLength;
-    property ContentType: String write SetContentType;
-    property OutputStream: TStream read FOutputStream;
-    property IsCommitted: Boolean;      // !!!: Implement this
-
-    // procedure FlushBuffer;           // !!!: Implement this
-    // procedure Reset;                 // !!!: Implement this
-    // procedure ResetBuffer;           // !!!: Implement this
-  end;
-
-  TGenericServlet = class(TComponent)
-  public
-    procedure Service(Req: TServletRequest; Resp: TServletResponse);
-      virtual; abstract;
-    property ServletContext: TServletContext;   // !!!: Implement this
-  end;
-
-
-
-implementation
-
-
-constructor TServletRequest.Create(AInputStream: TStream;
-  const AScheme, APathInfo: String);
-begin
-  inherited Create;
-  FInputStream := AInputStream;
-  FScheme := AScheme;
-  FPathInfo := APathInfo;
-end;
-
-
-constructor TServletResponse.Create(AOutputStream: TStream);
-begin
-  inherited Create;
-  FOutputStream := AOutputStream;
-end;
-
-
-end.

packages/fcl-net/src/xmlrpc.pp

@@ -1,941 +0,0 @@
-{
-
-    XML-RPC server and client library
-    Copyright (c) 2003-2004 by
-      Areca Systems GmbH / Sebastian Guenther, [email protected]
-
-    See the file COPYING.FPC, included in this distribution,
-    for details about the copyright.
-
-    This program is distributed in the hope that it will be useful,
-    but WITHOUT ANY WARRANTY; without even the implied warranty of
-    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
-}
-{$mode objfpc}{$H+}
-unit XMLRPC;
-
-interface
-
-uses SysUtils, Classes, fpAsync, ssockets, DOM, HTTPClient, HTTPSvlt;
-
-type
-  EXMLRPCParser = class(Exception);
-
-  TXMLRPCParams = class(TDOMElement);
-  TXMLRPCValue = class(TDOMElement);
-  TXMLRPCStruct = class(TXMLRPCValue);
-  TXMLRPCArray = class(TXMLRPCValue);
-
-  TXMLRPCWriter = class
-  private
-    Doc: TXMLDocument;
-  protected
-    function CreateValueEl: TXMLRPCValue;
-  public
-    constructor Create;
-    destructor Destroy; override;
-    function MakeStream: TMemoryStream;
-
-    procedure WriteMethodCall(const AMethodName: DOMString;
-      Params: TXMLRPCParams);
-    procedure WriteResponse(Value: TXMLRPCValue);
-    procedure WriteFaultResponse(FaultCode: LongInt;
-      const FaultString: DOMString);
-    function CreateParams: TXMLRPCParams;
-    procedure AddParam(Params: TXMLRPCParams; Value: TXMLRPCValue);
-    function CreateIntValue(i: LongInt): TXMLRPCValue;
-    function CreateBooleanValue(b: Boolean): TXMLRPCValue;
-    function CreateStringValue(const s: DOMString): TXMLRPCValue;
-    function CreateDoubleValue(d: Double): TXMLRPCValue;
-    function CreateDateTimeValue(dt: TDateTime): TXMLRPCValue;
-    function CreateStruct: TXMLRPCStruct;
-    procedure AddStructMember(Struct: TXMLRPCStruct; const Name: DOMString;
-      Member: TXMLRPCValue);
-    function CreateArray: TXMLRPCArray;
-    procedure AddArrayElement(AArray: TXMLRPCArray; Value: TXMLRPCValue);
-    // !!!: Missing: Binary data
-  end;
-
-  TXMLRPCPostType = (
-    xmlrpcInvalid,              // Invalid post type
-    xmlrpcMethodCall,           // Method call
-    xmlrpcResponse,             // Method call response (successfull)
-    xmlrpcFaultResponse);       // Method call response (failed)
-
-  TXMLRPCParser = class
-  private
-    Doc: TXMLDocument;
-    CurDataNode: TDOMNode;
-    InArray: Boolean;
-    procedure NextNode;
-    procedure PrevNode;
-    function GetValue: String;
-    function FindStructMember(AStruct: TXMLRPCStruct;
-      const AMemberName: String): TDOMElement;
-    function GetStructMemberValue(MemberNode: TDOMElement): String;
-  public
-    constructor Create(AStream: TStream);
-    destructor Destroy; override;
-    function GetPostType: TXMLRPCPostType;
-    function GetMethodName: String;
-    procedure ResetValueCursor;
-    // Simple values
-    function GetNextInt: LongInt;
-    function GetPrevInt: LongInt;
-    function GetNextBoolean: Boolean;
-    function GetPrevBoolean: Boolean;
-    function GetNextString: String;
-    function GetPrevString: String;
-    function GetNextDouble: Double;
-    function GetPrevDouble: Double;
-    // !!!: Missing: DateTime, Binary data
-    // Struct values
-    function GetNextStruct: TXMLRPCStruct;
-    function GetIntMember(AStruct: TXMLRPCStruct; const AName: String;
-      ADefault: Integer): Integer;
-    function GetBooleanMember(AStruct: TXMLRPCStruct; const AName: String;
-      ADefault: Boolean): Boolean;
-    function GetStringMember(AStruct: TXMLRPCStruct; const AName: String;
-      const ADefault: String): String;
-    function GetDoubleMember(AStruct: TXMLRPCStruct; const AName: String;
-      ADefault: Double): Double;
-    // Array values
-    procedure BeginArray;
-    procedure EndArray;
-  end;
-
-
-{$ifdef NEVERTRUE}
-  TOnXMLRPCCallCompleted = procedure(AParser: TXMLRPCParser) of object;
-
-  TXMLRPCClient = class
-  private
-    FEventLoop: TEventLoop;
-    FServerURL: String;
-    FOnBeginRPC, FOnEndRPC: TNotifyEvent;
-    RequestStream, ResponseStream: TMemoryStream;
-    CurCallback: TOnXMLRPCCallCompleted;
-    LocalEventLoop: TEventLoop;
-    Connection: TCustomHttpClient;
-
-    procedure MakeRequest(const AProcName: String; AArgs: array of const);
-    procedure ProcessAnswer;
-    procedure StreamSent(Sender: TObject);
-    procedure DataAvailable(Sender: TObject);
-  public
-    constructor Create(AEventLoop: TEventLoop);
-    procedure Call(ACallback: TOnXMLRPCCallCompleted;
-      const AProcName: String; AArgs: array of const);
-    procedure CallAsync(ACallback: TOnXMLRPCCallCompleted;
-      const AProcName: String; AArgs: array of const);
-
-    property EventLoop: TEventLoop read FEventLoop;
-    property ServerURL: String read FServerURL write FServerURL;
-
-    property OnBeginRPC: TNotifyEvent read FOnBeginRPC write FOnBeginRPC;
-    property OnEndRPC: TNotifyEvent read FOnEndRPC write FOnEndRPC;
-  end;
-{$endif}
-
-  TCheckCallEvent = procedure(AParser: TXMLRPCParser; const APath: TStrings;
-    var ExecCall: Boolean) of object;
-  TExceptionEvent = procedure(e: Exception) of object;
-
-  TXMLRPCServlet = class(THttpServlet)
-  private
-    FOnCheckCall: TCheckCallEvent;
-    FOnException: TExceptionEvent;
-  protected
-    procedure DoPost(Req: THttpServletRequest; Resp: THttpServletResponse);
-      override;
-  public
-    procedure Dispatch(AParser: TXMLRPCParser; AWriter: TXMLRPCWriter;
-      APath: TStrings); virtual; abstract;
-    property OnCheckCall: TCheckCallEvent read FOnCheckCall write FOnCheckCall;
-    property OnException: TExceptionEvent read FOnException write FOnException;
-  end;
-
-
-implementation
-
-uses XMLWrite, XMLRead;
-
-
-// Debugging stuff
-
-{$IFDEF XMLRPCDebug}
-const
-  NodeNames: array[ELEMENT_NODE..NOTATION_NODE] of String = (
-    'Element',
-    'Attribute',
-    'Text',
-    'CDATA section',
-    'Entity reference',
-    'Entity',
-    'Processing instruction',
-    'Comment',
-    'Document',
-    'Document type',
-    'Document fragment',
-    'Notation'
-  );
-
-procedure DumpNode(node: TDOMNode; spc: String);
-var
-  i: Integer;
-  attr: TDOMNode;
-begin
-  Write(spc, NodeNames[node.NodeType]);
-  if Copy(node.NodeName, 1, 1) <> '#' then
-    Write(' "', node.NodeName, '"');
-  if node.NodeValue <> '' then
-    Write(' "', node.NodeValue, '"');
-
-  if (node.Attributes <> nil) and (node.Attributes.Length > 0) then begin
-    Write(',');
-    for i := 0 to node.Attributes.Length - 1 do begin
-      attr := node.Attributes.Item[i];
-      Write(' ', attr.NodeName, ' = "', attr.NodeValue, '"');
-    end;
-  end;
-  WriteLn;
-
-  node := node.FirstChild;
-  while Assigned(node) do
-  begin
-    DumpNode(node, spc + '  ');
-    node := node.NextSibling;
-  end;
-end;
-{$ENDIF}
-
-
-// XML-RPC Writer
-
-constructor TXMLRPCWriter.Create;
-begin
-  inherited Create;
-  Doc := TXMLDocument.Create;
-end;
-
-destructor TXMLRPCWriter.Destroy;
-begin
-  Doc.Free;
-  inherited Destroy;
-end;
-
-function TXMLRPCWriter.MakeStream: TMemoryStream;
-begin
-  Result := TMemoryStream.Create;
-  try
-    WriteXMLFile(Doc, Result);
-//    WriteXMLFile(Doc, THandleStream.Create(StdOutputHandle));
-    Result.Position := 0;
-  except
-    on e: Exception do
-      Result.Free;
-  end;
-end;
-
-procedure TXMLRPCWriter.WriteMethodCall(const AMethodName: DOMString;
-  Params: TXMLRPCParams);
-var
-  El, El2: TDOMElement;
-begin
-  El := Doc.CreateElement('methodCall');
-  Doc.AppendChild(El);
-  El2 := Doc.CreateElement('methodName');
-  El.AppendChild(El2);
-  El2.AppendChild(Doc.CreateTextNode(AMethodName));
-  El.AppendChild(Params);
-end;
-
-procedure TXMLRPCWriter.WriteResponse(Value: TXMLRPCValue);
-var
-  El, El2: TDOMElement;
-begin
-  ASSERT(Value is TXMLRPCValue);
-  El := Doc.CreateElement('methodResponse');
-  Doc.AppendChild(El);
-  El2 := Doc.CreateElement('params');
-  El.AppendChild(El2);
-  if not Assigned(Value) then
-    Value := CreateBooleanValue(True);
-  El := Doc.CreateElement('param');
-  El2.AppendChild(El);
-  El.AppendChild(Value);
-end;
-
-procedure TXMLRPCWriter.WriteFaultResponse(FaultCode: LongInt;
-  const FaultString: DOMString);
-var
-  El, El2: TDOMElement;
-  Struct: TXMLRPCStruct;
-begin
-  El := Doc.CreateElement('methodResponse');
-  Doc.AppendChild(El);
-  El2 := Doc.CreateElement('fault');
-  El.AppendChild(El2);
-  Struct := CreateStruct;
-  AddStructMember(Struct, 'faultCode', CreateIntValue(FaultCode));
-  AddStructMember(Struct, 'faultString', CreateStringValue(FaultString));
-  El2.AppendChild(Struct);
-end;
-
-function TXMLRPCWriter.CreateParams: TXMLRPCParams;
-begin
-  Result := TXMLRPCParams(Doc.CreateElement('params'));
-end;
-
-procedure TXMLRPCWriter.AddParam(Params: TXMLRPCParams; Value: TXMLRPCValue);
-var
-  El: TDOMElement;
-begin
-  ASSERT((Params is TXMLRPCParams) and (Value is TXMLRPCValue));
-  El := Doc.CreateElement('param');
-  Params.AppendChild(El);
-  El.AppendChild(Value);
-end;
-
-function TXMLRPCWriter.CreateIntValue(i: LongInt): TXMLRPCValue;
-var
-  El: TDOMElement;
-begin
-  Result := CreateValueEl;
-  El := Doc.CreateElement('int');
-  Result.AppendChild(El);
-  El.AppendChild(Doc.CreateTextNode(IntToStr(i)));
-end;
-
-function TXMLRPCWriter.CreateBooleanValue(b: Boolean): TXMLRPCValue;
-var
-  El: TDOMElement;
-begin
-  Result := CreateValueEl;
-  El := Doc.CreateElement('boolean');
-  Result.AppendChild(El);
-  El.AppendChild(Doc.CreateTextNode(IntToStr(Ord(b))));
-end;
-
-function TXMLRPCWriter.CreateStringValue(const s: DOMString): TXMLRPCValue;
-var
-  El: TDOMElement;
-begin
-  Result := CreateValueEl;
-  El := Doc.CreateElement('string');
-  Result.AppendChild(El);
-  if Length(s) > 0 then
-    El.AppendChild(Doc.CreateTextNode(s));
-end;
-
-function TXMLRPCWriter.CreateDoubleValue(d: Double): TXMLRPCValue;
-var
-  El: TDOMElement;
-begin
-  Result := CreateValueEl;
-  El := Doc.CreateElement('double');
-  Result.AppendChild(El);
-  El.AppendChild(Doc.CreateTextNode(FloatToStr(d)));
-end;
-
-function TXMLRPCWriter.CreateDateTimeValue(dt: TDateTime): TXMLRPCValue;
-var
-  El: TDOMElement;
-begin
-  Result := CreateValueEl;
-  El := Doc.CreateElement('dateTime.iso8601');
-  Result.AppendChild(El);
-  El.AppendChild(Doc.CreateTextNode(FormatDateTime('ddmmyyyyThh:nn:ss', dt)));
-end;
-
-function TXMLRPCWriter.CreateStruct: TXMLRPCStruct;
-begin
-  Result := TXMLRPCStruct(CreateValueEl);
-  Result.AppendChild(Doc.CreateElement('struct'));
-end;
-
-procedure TXMLRPCWriter.AddStructMember(Struct: TXMLRPCStruct;
-  const Name: DOMString; Member: TXMLRPCValue);
-var
-  MemberEl, El: TDOMElement;
-begin
-  ASSERT((Struct is TXMLRPCStruct) and (Name <> '') and
-    (Member is TXMLRPCValue));
-  MemberEl := Doc.CreateElement('member');
-  Struct.FirstChild.AppendChild(MemberEl);
-  El := Doc.CreateElement('name');
-  MemberEl.AppendChild(El);
-  El.AppendChild(Doc.CreateTextNode(Name));
-  MemberEl.AppendChild(Member);
-end;
-
-function TXMLRPCWriter.CreateArray: TXMLRPCArray;
-var
-  ArrayEl: TDOMElement;
-begin
-  Result := TXMLRPCArray(CreateValueEl);
-  ArrayEl := Doc.CreateElement('array');
-  Result.AppendChild(ArrayEl);
-  ArrayEl.AppendChild(Doc.CreateElement('data'));
-end;
-
-procedure TXMLRPCWriter.AddArrayElement(AArray: TXMLRPCArray;
-  Value: TXMLRPCValue);
-begin
-  ASSERT((AArray is TXMLRPCArray) and (Value is TXMLRPCValue));
-  AArray.FirstChild.FirstChild.AppendChild(Value);
-end;
-
-function TXMLRPCWriter.CreateValueEl: TXMLRPCValue;
-begin
-  Result := TXMLRPCValue(Doc.CreateElement('value'));
-end;
-
-
-// XML-RPC Parser
-
-constructor TXMLRPCParser.Create(AStream: TStream);
-var
-  Node: TDOMNode;
-begin
-  inherited Create;
-  ReadXMLFile(Doc, AStream);
-  Node := Doc.DocumentElement;
-  {$IFDEF XMLRPCDebug}DumpNode(Node, 'Parser> ');{$ENDIF}
-  if (Node.NodeName = 'methodCall') or (Node.NodeName = 'methodResponse') then
-  begin
-    Node := Node.FirstChild;
-    while Assigned(Node) and (Node.NodeName <> 'params') do
-      Node := Node.NextSibling;
-    if Assigned(Node) then
-    begin
-      Node := Node.FirstChild;
-      while Assigned(Node) and (Node.NodeName <> 'param') do
-        Node := Node.NextSibling;
-      CurDataNode := Node;
-    end;
-  end;
-end;
-
-destructor TXMLRPCParser.Destroy;
-begin
-  Doc.Free;
-  inherited Destroy;
-end;
-
-function TXMLRPCParser.GetPostType: TXMLRPCPostType;
-var
-  Node: TDOMNode;
-begin
-  Result := xmlrpcInvalid;
-  Node := Doc.DocumentElement;
-  if Node.NodeName = 'methodCall' then
-    Result := xmlrpcMethodCall
-  else if Node.NodeName = 'methodResponse' then
-  begin
-    Node := Node.FirstChild;
-    while Assigned(Node) and (Node.NodeType <> ELEMENT_NODE) do
-      Node := Node.NextSibling;
-    if Assigned(Node) then
-      if Node.NodeName = 'params' then
-        Result := xmlrpcResponse
-      else if Node.NodeName = 'fault' then
-        Result := xmlrpcFaultResponse;
-  end;
-end;
-
-function TXMLRPCParser.GetMethodName: String;
-var
-  Node: TDOMNode;
-begin
-  SetLength(Result, 0);
-  Node := Doc.DocumentElement;
-  if (not Assigned(Node)) or (Node.NodeName <> 'methodCall') then
-    exit;
-  Node := Node.FindNode('methodName');
-  if not Assigned(Node) then
-    exit;
-  Node := Node.FirstChild;
-  while Assigned(Node) do
-  begin
-    if Node.NodeType = TEXT_NODE then
-      Result := Result + Node.NodeValue;
-    Node := Node.NextSibling;
-  end;
-end;
-
-procedure TXMLRPCParser.ResetValueCursor;
-begin
-  CurDataNode := CurDataNode.ParentNode.FirstChild;
-  {$IFDEF XMLRPCDebug}DumpNode(CurDataNode, 'ResetValueCursor> ');{$ENDIF}
-end;
-
-function TXMLRPCParser.GetNextInt: LongInt;
-begin
-  Result := StrToInt(GetValue);
-  NextNode;
-end;
-
-function TXMLRPCParser.GetPrevInt: LongInt;
-begin
-  PrevNode;
-  Result := StrToInt(GetValue);
-end;
-
-function TXMLRPCParser.GetNextBoolean: Boolean;
-begin
-  Result := GetValue = '1';
-  NextNode;
-end;
-
-function TXMLRPCParser.GetPrevBoolean: Boolean;
-begin
-  PrevNode;
-  Result := GetValue = '1';
-end;
-
-function TXMLRPCParser.GetNextString: String;
-begin
-  Result := GetValue;
-  NextNode;
-end;
-
-function TXMLRPCParser.GetPrevString: String;
-begin
-  PrevNode;
-  Result := GetValue;
-end;
-
-function TXMLRPCParser.GetNextDouble: Double;
-begin
-  Result := StrToFloat(GetValue);
-  NextNode;
-end;
-
-function TXMLRPCParser.GetPrevDouble: Double;
-begin
-  PrevNode;
-  Result := StrToFloat(GetValue);
-end;
-
-function TXMLRPCParser.GetNextStruct: TXMLRPCStruct;
-begin
-  if Assigned(CurDataNode) and Assigned(CurDataNode.FirstChild) then
-  begin
-    Result := TXMLRPCStruct(CurDataNode.FirstChild);
-    while Assigned(Result) and (Result.NodeName <> 'struct') do
-      Result := TXMLRPCStruct(Result.NextSibling);
-    NextNode;
-  end else
-    Result := nil;
-end;
-
-function TXMLRPCParser.GetIntMember(AStruct: TXMLRPCStruct;
-  const AName: String; ADefault: Integer): Integer;
-var
-  MemberNode: TDOMElement;
-begin
-  MemberNode := FindStructMember(AStruct, AName);
-  if Assigned(MemberNode) then
-    Result := StrToInt(GetStructMemberValue(MemberNode))
-  else
-    Result := ADefault;
-end;
-
-function TXMLRPCParser.GetBooleanMember(AStruct: TXMLRPCStruct;
-  const AName: String; ADefault: Boolean): Boolean;
-var
-  MemberNode: TDOMElement;
-begin
-  MemberNode := FindStructMember(AStruct, AName);
-  if Assigned(MemberNode) then
-    Result := GetStructMemberValue(MemberNode) = '1'
-  else
-    Result := ADefault;
-end;
-
-function TXMLRPCParser.GetStringMember(AStruct: TXMLRPCStruct;
-  const AName: String; const ADefault: String): String;
-var
-  MemberNode: TDOMElement;
-begin
-  MemberNode := FindStructMember(AStruct, AName);
-  if Assigned(MemberNode) then
-    Result := GetStructMemberValue(MemberNode)
-  else
-    Result := ADefault;
-end;
-
-function TXMLRPCParser.GetDoubleMember(AStruct: TXMLRPCStruct;
-  const AName: String; ADefault: Double): Double;
-var
-  MemberNode: TDOMElement;
-begin
-  MemberNode := FindStructMember(AStruct, AName);
-  if Assigned(MemberNode) then
-    Result := StrToFloat(GetStructMemberValue(MemberNode))
-  else
-    Result := ADefault;
-end;
-
-procedure TXMLRPCParser.BeginArray;
-begin
-  if Assigned(CurDataNode) then
-  begin
-    CurDataNode := CurDataNode.FirstChild;
-    while Assigned(CurDataNode) and (CurDataNode.NodeName <> 'array') do
-      CurDataNode := CurDataNode.NextSibling;
-    if Assigned(CurDataNode) then
-    begin
-      CurDataNode := CurDataNode.FirstChild;
-      while Assigned(CurDataNode) and (CurDataNode.NodeName <> 'data') do
-        CurDataNode := CurDataNode.NextSibling;
-{      if Assigned(CurDataNode) then
-      begin
-        CurDataNodeParent := CurDataNode;
-        CurDataNode := nil;
-        ResetValueCursor;
-      end;}
-    end;
-    //NextNode;
-  end;
-end;
-
-procedure TXMLRPCParser.EndArray;
-begin
-end;
-
-procedure TXMLRPCParser.NextNode;
-begin
-  repeat
-    CurDataNode := CurDataNode.NextSibling;
-  until (not Assigned(CurDataNode)) or (CurDataNode.NodeType = ELEMENT_NODE);
-end;
-
-procedure TXMLRPCParser.PrevNode;
-begin
-  {$IFDEF XMLRPCDebug}DumpNode(CurDataNode, 'PrevNode before> ');{$ENDIF}
-  if Assigned(CurDataNode.PreviousSibling) then
-    CurDataNode := CurDataNode.PreviousSibling
-  else
-    CurDataNode := CurDataNode.ParentNode.LastChild;
-  {$IFDEF XMLRPCDebug}DumpNode(CurDataNode, 'PrevNode result> ');{$ENDIF}
-end;
-
-function TXMLRPCParser.GetValue: String;
-var
-  Node: TDOMNode;
-begin
-  if not Assigned(CurDataNode) then
-    Result := ''
-  else
-  begin
-    Node := CurDataNode;
-    if Node.NodeName <> 'value' then
-      Node := Node.FirstChild;
-    Node := Node.FirstChild;
-    if Node.NodeType = TEXT_NODE then
-      Result := Node.NodeValue
-    else begin
-      while Assigned(Node) and (Node.NodeType <> ELEMENT_NODE) do
-        Node := Node.NextSibling;
-      if Assigned(Node) then
-      begin
-        Node := Node.FirstChild;
-        if Assigned(Node) and (Node.NodeType = TEXT_NODE) then
-          Result := Node.NodeValue
-        else
-          Result := '';
-      end;
-    end;
-  end;
-end;
-
-function TXMLRPCParser.FindStructMember(AStruct: TXMLRPCStruct;
-  const AMemberName: String): TDOMElement;
-var
-  Node: TDOMNode;
-begin
-  Result := TDOMElement(AStruct.FirstChild);
-  while Assigned(Result) and (Result.NodeName = 'member') do
-  begin
-    Node := Result.FirstChild;
-    while Assigned(Node) do
-    begin
-      if Node.NodeName = 'name' then
-      begin
-        if Assigned(Node.FirstChild) and
-          (CompareText(Node.FirstChild.NodeValue, AMemberName) = 0) then
-          exit;
-      end;
-      Node := Node.NextSibling;
-    end;
-    Result := TDOMElement(Result.NextSibling);
-  end;
-end;
-
-function TXMLRPCParser.GetStructMemberValue(MemberNode: TDOMElement): String;
-var
-  Node, Subnode: TDOMNode;
-begin
-  Node := MemberNode.FirstChild;
-  while Assigned(Node) do
-  begin
-    if Node.NodeName = 'value' then
-    begin
-       Subnode := Node.FirstChild;
-       if Assigned(Subnode) and (Subnode.NodeType = TEXT_NODE) then
-       begin
-         Result := Subnode.NodeValue;
-         exit;
-       end;
-       while Assigned(Subnode) do
-       begin
-         if Subnode.NodeType = ELEMENT_NODE then
-         begin
-           if Assigned(Subnode.FirstChild) then
-             Result := Subnode.FirstChild.NodeValue
-           else
-             Result := '';
-           exit;
-         end;
-         Subnode := Subnode.NextSibling;
-       end;
-    end;
-    Node := Node.NextSibling;
-  end;
-end;
-
-
-{$IFDEF NEVERTRUE}
-// XML-RPC Client
-
-constructor TXMLRPCClient.Create(AEventLoop: TEventLoop);
-begin
-  inherited Create;
-  FEventLoop := AEventLoop;
-end;
-
-procedure TXMLRPCClient.Call(ACallback: TOnXMLRPCCallCompleted;
-  const AProcName: String; AArgs: array of const);
-var
-  Host: String;
-  Port: Word;
-  Socket: TInetSocket;
-begin
-  CurCallback := ACallback;
-  MakeRequest(AProcName, AArgs);
-  try
-    ResponseStream := TMemoryStream.Create;
-    if Assigned(OnBeginRPC) then
-      OnBeginRPC(Self);
-
-    Host := 'localhost';
-    Port := 12345;
-
-    Socket := TInetSocket.Create(Host, Port);
-    try
-      RequestStream.Position := 0;
-//    Socket.Write(RequestStream.Memory^, RequestStream.Size);
-      LocalEventLoop := TEventLoop.Create;
-      try
-        Connection := TCustomHttpClient.Create(LocalEventLoop, Socket);
-        try
-          Connection.HeaderToSend := THttpRequestHeader.Create;
-          with THttpRequestHeader(Connection.HeaderToSend) do
-          begin
-            Command := 'POST';
-            URI := '/xmlrpc';
-            UserAgent := 'Free Pascal XML-RPC';
-            ContentType := 'text/xml';
-            ContentLength := RequestStream.Size;
-          end;
-          Connection.StreamToSend := RequestStream;
-          Connection.ReceivedHeader := THttpResponseHeader.Create;
-          Connection.ReceivedStream := ResponseStream;
-          Connection.OnStreamSent := @StreamSent;
-          Connection.Send;
-          LocalEventLoop.Run;
-        finally
-          if Assigned(Connection) then
-          begin
-            Connection.HeaderToSend.Free;
-            Connection.ReceivedHeader.Free;
-          end;
-          Connection.Free;
-        end;
-      finally
-        LocalEventLoop.Free;
-      end;
-    finally
-      Socket.Free;
-    end;
-  finally
-    FreeAndNil(RequestStream);
-  end;
-
-//  HTTPConnection.Post(ServerURL, RequestStream, ResponseStream);
-  ProcessAnswer;
-end;
-
-procedure TXMLRPCClient.CallAsync(ACallback: TOnXMLRPCCallCompleted;
-  const AProcName: String; AArgs: array of const);
-begin
-  CurCallback := ACallback;
-  MakeRequest(AProcName, AArgs);
-  ResponseStream := TMemoryStream.Create;
-  if Assigned(OnBeginRPC) then
-    OnBeginRPC(Self);
-
-//  CurRPCThread := TRPCThread.Create(Self);
-end;
-
-procedure TXMLRPCClient.MakeRequest(const AProcName: String;
-  AArgs: array of const);
-var
-  Writer: TXMLRPCWriter;
-  Params: TXMLRPCParams;
-  i: Integer;
-begin
-  Writer := TXMLRPCWriter.Create;
-  try
-    Params := Writer.CreateParams;
-    try
-      for i := Low(AArgs) to High(AArgs) do
-        with AArgs[i] do
-          case VType of
-            vtInteger: Writer.AddParam(Params, Writer.CreateIntValue(VInteger));
-            vtBoolean: Writer.AddParam(Params, Writer.CreateBooleanValue(VBoolean));
-            vtChar: Writer.AddParam(Params, Writer.CreateStringValue(VChar));
-            vtExtended: Writer.AddParam(Params, Writer.CreateDoubleValue(VExtended^));
-            vtString: Writer.AddParam(Params, Writer.CreateStringValue(VString^));
-            vtPChar: Writer.AddParam(Params, Writer.CreateStringValue(VPChar));
-            vtWideChar: Writer.AddParam(Params, Writer.CreateStringValue(VWideChar));
-            vtPWideChar: Writer.AddParam(Params, Writer.CreateStringValue(VPWideChar));
-            vtAnsiString: Writer.AddParam(Params, Writer.CreateStringValue(String(VAnsiString)));
-            // vtCurrency: ?
-            // vtVariant: ?
-            vtInt64: Writer.AddParam(Params, Writer.CreateIntValue(VInt64^));
-          else
-            raise Exception.Create('Unsupported data type in RPC argument list');
-          end;
-      Writer.WriteMethodCall(AProcName, Params);
-      RequestStream := Writer.MakeStream;
-    except
-      Params.Free;
-    end;
-  finally
-    Writer.Free;
-  end;
-end;
-
-procedure TXMLRPCClient.ProcessAnswer;
-var
-  Parser: TXMLRPCParser;
-begin
-  ResponseStream.Position := 0;
-  Parser := TXMLRPCParser.Create(ResponseStream);
-  FreeAndNil(ResponseStream);
-  try
-    case Parser.GetPostType of
-      xmlrpcFaultResponse:
-}        {raise Exception.Create(Format('%d - %s', [Parser.GetNextInt,
-          Parser.GetNextString]));}
-{        raise Exception.Create('Fehler bei XML-RPC-Befehlsausführung');
-      xmlrpcResponse:
-        if Assigned(CurCallback) then
-          CurCallback(Parser);
-    else
-      raise Exception.Create('Invalid response');
-    end;
-  finally
-    Parser.Free;
-    if Assigned(OnEndRPC) then
-      OnEndRPC(Self);
-  end;
-end;
-
-procedure TXMLRPCClient.StreamSent(Sender: TObject);
-begin
-//  LocalEventLoop.Break;
-  Connection.Receive;
-end;
-
-procedure TXMLRPCClient.DataAvailable(Sender: TObject);
-begin
-  LocalEventLoop.Break;
-end;
-}
-{$ENDIF NEVERTRUE}
-
-// XML-RPC Server
-
-procedure TXMLRPCServlet.DoPost(Req: THttpServletRequest;
-  Resp: THttpServletResponse);
-var
-  Parser: TXMLRPCParser;
-  Writer: TXMLRPCWriter;
-  Path: TStringList;
-  LastDot, i: Integer;
-  s, PathStr: String;
-  AnswerStream: TStream;
-  ExecCall: Boolean;
-begin
-  Parser := TXMLRPCParser.Create(Req.InputStream);
-  try
-    if Parser.GetPostType <> xmlrpcMethodCall then
-      exit;
-
-    Resp.ContentType := 'text/xml';
-
-    Writer := TXMLRPCWriter.Create;
-    try
-      try
-        // ...Header auswerten und zum Dispatcher springen...
-        PathStr := Parser.GetMethodName + '.';
-        Path := TStringList.Create;
-        try
-          LastDot := 1;
-          for i := 1 to Length(PathStr) do
-            if PathStr[i] = '.' then
-            begin
-              Path.Add(UpperCase(Copy(PathStr, LastDot, i - LastDot)));
-              LastDot := i + 1;
-            end;
-          ExecCall := True;
-          if Assigned(OnCheckCall) then
-            OnCheckCall(Parser, Path, ExecCall);
-          if ExecCall then
-            Dispatch(Parser, Writer, Path)
-          else
-            Writer.WriteFaultResponse(2, 'May not execute request');
-        finally
-          Path.Free;
-        end;
-      except
-        on e: Exception do
-        begin
-          if Assigned(OnException) then
-            OnException(e);
-          Writer.WriteFaultResponse(2,
-            'Execution error: ' + e.ClassName + ': ' + e.Message);
-        end;
-      end;
-
-      AnswerStream := Writer.MakeStream;
-      try
-        Resp.ContentLength := AnswerStream.Size;
-        Resp.OutputStream.CopyFrom(AnswerStream, AnswerStream.Size);
-      finally
-        AnswerStream.Free;
-      end;
-    finally
-      Writer.Free;
-    end;
-  finally
-    Parser.Free;
-  end;
-end;
-
-
-end.