src/generate/t_html_generator.cc \
src/generate/t_js_generator.cc \
src/generate/t_javame_generator.cc \
+ src/generate/t_delphi_generator.cc \
src/generate/t_go_generator.cc
thrift_CPPFLAGS = -I$(srcdir)/src
--- /dev/null
+/*
+ * Licensed to the Apache Software Foundation (ASF) under one
+ * or more contributor license agreements. See the NOTICE file
+ * distributed with this work for additional information
+ * regarding copyright ownership. The ASF licenses this file
+ * to you under the Apache License, Version 2.0 (the
+ * "License"); you may not use this file except in compliance
+ * with the License. You may obtain a copy of the License at
+ *
+ * http://www.apache.org/licenses/LICENSE-2.0
+ *
+ * Unless required by applicable law or agreed to in writing,
+ * software distributed under the License is distributed on an
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+ * KIND, either express or implied. See the License for the
+ * specific language governing permissions and limitations
+ * under the License.
+ *
+ * Contains some contributions under the Thrift Software License.
+ * Please see doc/old-thrift-license.txt in the Thrift distribution for
+ * details.
+ */
+
+#include <string>
+#include <fstream>
+#include <iostream>
+#include <vector>
+
+#include <stdlib.h>
+#include <sys/stat.h>
+#include <sstream>
+
+#include <boost/uuid/uuid.hpp>
+#include <boost/uuid/uuid_generators.hpp>
+#include <boost/uuid/uuid_io.hpp>
+
+#include "platform.h"
+#include "t_oop_generator.h"
+
+using namespace std;
+
+
+class t_delphi_generator : public t_oop_generator
+{
+ public:
+ t_delphi_generator(
+ t_program* program,
+ const std::map<std::string, std::string>& parsed_options,
+ const std::string& option_string)
+ : t_oop_generator(program)
+ {
+ (void) option_string;
+
+ std::map<std::string, std::string>::const_iterator iter;
+
+ iter = parsed_options.find("ansistr_binary");
+ ansistr_binary_ = (iter != parsed_options.end());
+
+ iter = parsed_options.find("suppress_guid");
+ suppress_guid_ = (iter != parsed_options.end());
+
+ out_dir_base_ = "gen-delphi";
+ escape_.clear();
+ escape_['\''] = "''";
+ }
+
+
+ void init_generator();
+ void close_generator();
+
+ void generate_consts(std::vector<t_const*> consts);
+
+ void generate_typedef (t_typedef* ttypedef);
+ void generate_enum (t_enum* tenum);
+ void generate_struct (t_struct* tstruct);
+ void generate_xception (t_struct* txception);
+ void generate_service (t_service* tservice);
+ void generate_property(ostream& out, t_field* tfield, bool isPublic, bool is_xception);
+ void generate_property_writer_(ostream& out, t_field* tfield, bool isPublic);
+
+ void generate_delphi_property(ostream& out, bool struct_is_exception, t_field* tfield, bool isPublic, std::string fieldPrefix = "");
+ void generate_delphi_isset_reader_definition(ostream& out, t_field* tfield);
+ void generate_delphi_property_reader_definition(ostream& out, t_field* tfield);
+ void generate_delphi_property_writer_definition(ostream& out, t_field* tfield);
+ void generate_delphi_property_reader_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix);
+ void generate_delphi_property_writer_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix, bool is_xception_class, std::string xception_factroy_name);
+ void generate_delphi_isset_reader_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix);
+ void generate_delphi_struct_writer_impl(ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception);
+ void generate_delphi_struct_result_writer_impl(ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception);
+
+ void generate_delphi_struct_tostring_impl(ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception);
+
+ void add_delphi_uses_list( string unitname);
+
+ void generate_delphi_struct_reader_impl(ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception);
+ void generate_delphi_create_exception_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception);
+
+ void print_const_prop(std::ostream& out, string name, t_type* type, t_const_value* value);
+ void print_private_field(std::ostream& out, string name, t_type* type, t_const_value* value);
+ void print_const_value ( std::ostream& vars, std::ostream& out, std::string name, t_type* type, t_const_value* value);
+ void initialize_field(std::ostream& vars, std::ostream& out, std::string name, t_type* type, t_const_value* value, std::string cls_nm = "");
+ void finalize_field(std::ostream& out, std::string name, t_type* type, t_const_value* value, std::string cls_nm = "");
+ std::string render_const_value( std::ostream& local_vars, std::ostream& out, std::string name, t_type* type, t_const_value* value);
+ void print_const_def_value( std::ostream& vars, std::ostream& out, std::string name, t_type* type, t_const_value* value, std::string cls_nm = "");
+
+ void generate_delphi_struct(t_struct* tstruct, bool is_exception);
+ void generate_delphi_struct_impl( ostream& out, std::string cls_prefix, t_struct* tstruct, bool is_exception, bool is_result = false, bool is_x_factory = false);
+ void generate_delphi_struct_definition(std::ostream& out, t_struct* tstruct, bool is_xception=false, bool in_class=false, bool is_result=false, bool is_x_factory = false);
+ void generate_delphi_struct_reader(std::ostream& out, t_struct* tstruct);
+ void generate_delphi_struct_result_writer(std::ostream& out, t_struct* tstruct);
+ void generate_delphi_struct_writer(std::ostream& out, t_struct* tstruct);
+ void generate_delphi_struct_tostring(std::ostream& out, t_struct* tstruct);
+
+ void generate_function_helpers(t_function* tfunction);
+ void generate_service_interface (t_service* tservice);
+ void generate_service_helpers (t_service* tservice);
+ void generate_service_client (t_service* tservice);
+ void generate_service_server (t_service* tservice);
+ void generate_process_function (t_service* tservice, t_function* function);
+
+ void generate_deserialize_field (std::ostream& out, bool is_xception, t_field* tfield, std::string prefix, std::ostream& local_vars);
+ void generate_deserialize_struct (std::ostream& out, t_struct* tstruct, std::string name, std::string prefix);
+ void generate_deserialize_container(ostream& out, bool is_xception, t_type* ttype, string name, std::ostream& local_vars);
+
+ void generate_deserialize_set_element (std::ostream& out, bool is_xception, t_set* tset, std::string prefix, std::ostream& local_vars);
+ void generate_deserialize_map_element (std::ostream& out, bool is_xception, t_map* tmap, std::string prefix, std::ostream& local_vars);
+ void generate_deserialize_list_element (std::ostream& out, bool is_xception, t_list* list, std::string prefix, std::ostream& local_vars);
+
+ void generate_serialize_field (std::ostream& out, bool is_xception, t_field* tfield, std::string prefix, std::ostream& local_vars);
+ void generate_serialize_struct (std::ostream& out, t_struct* tstruct, std::string prefix, std::ostream& local_vars);
+ void generate_serialize_container (std::ostream& out, bool is_xception, t_type* ttype, std::string prefix, std::ostream& local_vars);
+ void generate_serialize_map_element (std::ostream& out, bool is_xception, t_map* tmap, std::string iter, std::string map, std::ostream& local_vars);
+ void generate_serialize_set_element (std::ostream& out, bool is_xception, t_set* tmap, std::string iter, std::ostream& local_vars);
+ void generate_serialize_list_element (std::ostream& out, bool is_xception, t_list* tlist, std::string iter, std::ostream& local_vars);
+
+ void delphi_type_usings(std::ostream& out);
+ std::string delphi_thrift_usings();
+
+ std::string type_name( t_type* ttype, bool b_cls=false, bool b_no_postfix=false, bool b_exception_factory=false, bool b_full_exception_factory = false);
+ std::string normalize_clsnm(std::string name, std::string prefix, bool b_no_check_keyword = false);
+
+ std::string base_type_name(t_base_type* tbase);
+ std::string declare_field(t_field* tfield, bool init=false, std::string prefix="");
+ std::string function_signature(t_function* tfunction, std::string full_cls="", bool is_xception = false);
+ std::string argument_list(t_struct* tstruct);
+ std::string type_to_enum(t_type* ttype);
+ std::string prop_name(t_field* tfield, bool is_xception = false);
+ std::string prop_name(std::string name, bool is_xception = false);
+
+ void write_enum(std::string line);
+ void write_forward_decr(std::string line);
+ void write_const(std::string line);
+ void write_struct(std::string line);
+ void write_service(std::string line);
+
+ virtual std::string autogen_comment() {
+ return
+ std::string("(**\n") +
+ " * Autogenerated by Thrift\n" +
+ " *\n" +
+ " * DO NOT EDIT UNLESS YOU ARE SURE THAT YOU KNOW WHAT YOU ARE DOING\n" +
+ " *)\n";
+ }
+
+ bool type_can_be_null(t_type* ttype) {
+ while (ttype->is_typedef()) {
+ ttype = ((t_typedef*)ttype)->get_type();
+ }
+
+ return ttype->is_container() ||
+ ttype->is_struct() ||
+ ttype->is_xception();
+ }
+
+ private:
+ std::string namespace_name_;
+ std::ostringstream s_forward_decr;
+ std::ostringstream s_enum;
+ std::ostringstream s_const;
+ std::ostringstream s_struct;
+ std::ostringstream s_service;
+ std::ostringstream s_const_impl;
+ std::ostringstream s_struct_impl;
+ std::ostringstream s_service_impl;
+ bool has_enum;
+ bool has_const;
+ std::string namespace_dir_;
+ std::map<std::string, int> delphi_keywords;
+ std::map<std::string, int> delphi_reserved_method;
+ std::map<std::string, int> delphi_reserved_method_exception;
+ std::vector<std::string> uses_list;
+ void create_keywords();
+ bool find_keyword( std::map<std::string, int>& keyword_map, std::string name);
+ std::string normalize_name( std::string name, bool b_method = false, bool b_exception_method = false);
+ std::string empty_value(t_type* type);
+ bool is_void( t_type* type );
+ int indent_impl_;
+ bool ansistr_binary_;
+ bool suppress_guid_;
+
+ std::string generate_guid();
+
+ void indent_up_impl(){
+ ++indent_impl_;
+ };
+ void indent_down_impl() {
+ --indent_impl_;
+ };
+ std::string indent_impl() {
+ std::string ind = "";
+ int i;
+ for (i = 0; i < indent_impl_; ++i) {
+ ind += " ";
+ }
+ return ind;
+ };
+ std::ostream& indent_impl(std::ostream &os) {
+ return os << indent_impl();
+ };
+};
+
+/**
+ * Generates a new UUID/GUID for internal purposes.
+ * These GUIDs are not intended to be used cross-module,
+ * as they are always re-generated and NOT constant!
+ *
+ * @return Pascal-style GUID.
+ */
+std::string t_delphi_generator::generate_guid() {
+ boost::uuids::basic_random_generator<boost::mt19937> gen;
+ boost::uuids::uuid u = gen();
+ std::ostringstream stream;
+ stream << u;
+ return "['{" + upcase_string(stream.str()) + "}']";
+}
+
+bool t_delphi_generator::find_keyword( std::map<std::string, int>& keyword_map, std::string name) {
+ int len = name.length();
+
+ if ( len <= 0 ) {
+ return false;
+ }
+
+ int nlast = name.find_last_of('_');
+
+ if ( nlast >= 1) {
+ if (nlast == (len - 1)) {
+ string new_name( name, 0, nlast);
+ return find_keyword( keyword_map, new_name);
+ }
+ }
+ return (keyword_map[name] == 1);
+}
+
+std::string t_delphi_generator::normalize_name( std::string name, bool b_method, bool b_exception_method) {
+ string tmp( name );
+ std::transform(tmp.begin(), tmp.end(), tmp.begin(), static_cast<int (*)(int)>(std::tolower));
+
+ bool b_found = false;
+
+ if ( find_keyword( delphi_keywords, tmp) ) {
+ b_found = true;
+ } else if ( b_method && find_keyword( delphi_reserved_method, tmp)) {
+ b_found = true;
+ } else if ( b_method && find_keyword( delphi_reserved_method_exception, tmp)) {
+ b_found = true;
+ }
+
+ if (b_found) {
+ return name + "_";
+ } else {
+ return name;
+ }
+}
+
+void t_delphi_generator::create_keywords() {
+ delphi_keywords["and"] = 1;
+ delphi_keywords["end"] = 1;
+ delphi_keywords["interface"] = 1;
+ delphi_keywords["raise"] = 1;
+ delphi_keywords["uses"] = 1;
+ delphi_keywords["array"] = 1;
+ delphi_keywords["except"] = 1;
+ delphi_keywords["is"] = 1;
+ delphi_keywords["record"] = 1;
+ delphi_keywords["var"] = 1;
+ delphi_keywords["as"] = 1;
+ delphi_keywords["exports"] = 1;
+ delphi_keywords["label"] = 1;
+ delphi_keywords["repeat"] = 1;
+ delphi_keywords["while"] = 1;
+ delphi_keywords["asm"] = 1;
+ delphi_keywords["file"] = 1;
+ delphi_keywords["library"] = 1;
+ delphi_keywords["resourcestring"] = 1;
+ delphi_keywords["with"] = 1;
+ delphi_keywords["begin"] = 1;
+ delphi_keywords["finalization"] = 1;
+ delphi_keywords["mod"] = 1;
+ delphi_keywords["set"] = 1;
+ delphi_keywords["xor"] = 1;
+ delphi_keywords["case"] = 1;
+ delphi_keywords["finally"] = 1;
+ delphi_keywords["nil"] = 1;
+ delphi_keywords["shl"] = 1;
+ delphi_keywords["class"] = 1;
+ delphi_keywords["for"] = 1;
+ delphi_keywords["not"] = 1;
+ delphi_keywords["shr"] = 1;
+ delphi_keywords["const"] = 1;
+ delphi_keywords["function"] = 1;
+ delphi_keywords["object"] = 1;
+ delphi_keywords["string"] = 1;
+ delphi_keywords["constructor"] = 1;
+ delphi_keywords["goto"] = 1;
+ delphi_keywords["of"] = 1;
+ delphi_keywords["then"] = 1;
+ delphi_keywords["destructor"] = 1;
+ delphi_keywords["if"] = 1;
+ delphi_keywords["or"] = 1;
+ delphi_keywords["threadvar"] = 1;
+ delphi_keywords["dispinterface"] = 1;
+ delphi_keywords["implementation"] = 1;
+ delphi_keywords["out"] = 1;
+ delphi_keywords["to"] = 1;
+ delphi_keywords["div"] = 1;
+ delphi_keywords["in"] = 1;
+ delphi_keywords["packed"] = 1;
+ delphi_keywords["try"] = 1;
+ delphi_keywords["do"] = 1;
+ delphi_keywords["inherited"] = 1;
+ delphi_keywords["procedure"] = 1;
+ delphi_keywords["type"] = 1;
+ delphi_keywords["downto"] = 1;
+ delphi_keywords["initialization"] = 1;
+ delphi_keywords["program"] = 1;
+ delphi_keywords["unit"] = 1;
+ delphi_keywords["else"] = 1;
+ delphi_keywords["inline"] = 1;
+ delphi_keywords["property"] = 1;
+ delphi_keywords["until"] = 1;
+ delphi_keywords["private"] = 1;
+ delphi_keywords["protected"] = 1;
+ delphi_keywords["public"] = 1;
+ delphi_keywords["published"] = 1;
+ delphi_keywords["automated"] = 1;
+ delphi_keywords["at"] = 1;
+ delphi_keywords["on"] = 1;
+
+ delphi_reserved_method["create"] = 1;
+ delphi_reserved_method["free"] = 1;
+ delphi_reserved_method["initinstance"] = 1;
+ delphi_reserved_method["cleanupinstance"] = 1;
+ delphi_reserved_method["classtype"] = 1;
+ delphi_reserved_method["classname"] = 1;
+ delphi_reserved_method["classnameis"] = 1;
+ delphi_reserved_method["classparent"] = 1;
+ delphi_reserved_method["classinfo"] = 1;
+ delphi_reserved_method["instancesize"] = 1;
+ delphi_reserved_method["inheritsfrom"] = 1;
+ delphi_reserved_method["methodaddress"] = 1;
+ delphi_reserved_method["methodaddress"] = 1;
+ delphi_reserved_method["methodname"] = 1;
+ delphi_reserved_method["fieldaddress"] = 1;
+ delphi_reserved_method["fieldaddress"] = 1;
+ delphi_reserved_method["getinterface"] = 1;
+ delphi_reserved_method["getinterfaceentry"] = 1;
+ delphi_reserved_method["getinterfacetable"] = 1;
+ delphi_reserved_method["unitname"] = 1;
+ delphi_reserved_method["equals"] = 1;
+ delphi_reserved_method["gethashcode"] = 1;
+ delphi_reserved_method["tostring"] = 1;
+ delphi_reserved_method["safecallexception"] = 1;
+ delphi_reserved_method["afterconstruction"] = 1;
+ delphi_reserved_method["beforedestruction"] = 1;
+ delphi_reserved_method["dispatch"] = 1;
+ delphi_reserved_method["defaulthandler"] = 1;
+ delphi_reserved_method["newinstance"] = 1;
+ delphi_reserved_method["freeinstance"] = 1;
+ delphi_reserved_method["destroy"] = 1;
+ delphi_reserved_method["read"] = 1;
+ delphi_reserved_method["write"] = 1;
+
+ delphi_reserved_method_exception["setinnerexception"] = 1;
+ delphi_reserved_method_exception["setstackinfo"] = 1;
+ delphi_reserved_method_exception["getstacktrace"] = 1;
+ delphi_reserved_method_exception["raisingexception"] = 1;
+ delphi_reserved_method_exception["createfmt"] = 1;
+ delphi_reserved_method_exception["createres"] = 1;
+ delphi_reserved_method_exception["createresfmt"] = 1;
+ delphi_reserved_method_exception["createhelp"] = 1;
+ delphi_reserved_method_exception["createfmthelp"] = 1;
+ delphi_reserved_method_exception["createreshelp"] = 1;
+ delphi_reserved_method_exception["createresfmthelp"] = 1;
+ delphi_reserved_method_exception["getbaseexception"] = 1;
+ delphi_reserved_method_exception["baseexception"] = 1;
+ delphi_reserved_method_exception["helpcontext"] = 1;
+ delphi_reserved_method_exception["innerexception"] = 1;
+ delphi_reserved_method_exception["message"] = 1;
+ delphi_reserved_method_exception["stacktrace"] = 1;
+ delphi_reserved_method_exception["stackinfo"] = 1;
+ delphi_reserved_method_exception["getexceptionstackinfoproc"] = 1;
+ delphi_reserved_method_exception["getstackinfostringproc"] = 1;
+ delphi_reserved_method_exception["cleanupstackinfoproc"] = 1;
+ delphi_reserved_method_exception["raiseouterexception"] = 1;
+ delphi_reserved_method_exception["throwouterexception"] = 1;
+}
+
+void t_delphi_generator::add_delphi_uses_list( string unitname){
+ vector<std::string>::const_iterator s_iter;
+ bool found = false;
+ for (s_iter = uses_list.begin(); s_iter != uses_list.end(); ++s_iter) {
+ if ((*s_iter) == unitname ) {
+ found = true;
+ break;
+ }
+ }
+ if (! found) {
+ uses_list.push_back( unitname );
+ }
+}
+
+void t_delphi_generator::init_generator() {
+ indent_impl_ = 0;
+ namespace_name_ = program_->get_namespace("delphi");
+ has_enum = false;
+ has_const = false;
+ create_keywords();
+ add_delphi_uses_list("Classes");
+ add_delphi_uses_list("SysUtils");
+ add_delphi_uses_list("Generics.Collections");
+ add_delphi_uses_list("Thrift");
+ add_delphi_uses_list("Thrift.Utils");
+ add_delphi_uses_list("Thrift.Collections");
+ add_delphi_uses_list("Thrift.Protocol");
+ add_delphi_uses_list("Thrift.Transport");
+
+ string unitname, nsname;
+ const vector<t_program*>& includes = program_->get_includes();
+ for (size_t i = 0; i < includes.size(); ++i) {
+ unitname = includes[i]->get_name();
+ nsname = includes[i]->get_namespace("delphi");
+ if ( "" != nsname) {
+ unitname = nsname;
+ }
+ add_delphi_uses_list(unitname);
+ }
+
+
+ MKDIR(get_out_dir().c_str());
+}
+
+void t_delphi_generator::close_generator() {
+ std::string unitname = program_name_;
+ if( "" != namespace_name_) {
+ unitname = namespace_name_;
+ }
+
+ for ( int i = 0; i < (int)unitname.size(); i++) {
+ if ( unitname[i] == ' ' ) {
+ unitname.replace( i, 1, "_" );
+ }
+ }
+
+ std::string f_name = get_out_dir() + "/" + unitname + ".pas";
+ std::ofstream f_all;
+
+ f_all.open( f_name.c_str() );
+
+ f_all << autogen_comment() << endl;
+ f_all << "unit " << unitname << ";" << endl << endl;
+ f_all << "interface" << endl << endl;
+ f_all << "uses" << endl;
+
+ indent_up();
+
+ vector<std::string>::const_iterator s_iter;
+ for (s_iter = uses_list.begin(); s_iter != uses_list.end(); ++s_iter) {
+ if (s_iter != uses_list.begin()) {
+ f_all << ",";
+ f_all << endl;
+ }
+ indent(f_all) << *s_iter;
+ }
+
+ f_all << ";" << endl << endl;
+
+ indent_down();
+
+ string tmp_unit( unitname );
+ for ( int i = 0; i < (int)tmp_unit.size(); i++) {
+ if ( tmp_unit[i] == '.' ) {
+ tmp_unit.replace( i, 1, "_" );
+ }
+ }
+
+ f_all << "const" << endl;
+ indent_up();
+ indent(f_all) << "c" << tmp_unit << "_Option_AnsiStr_Binary = " << ( ansistr_binary_ ? "True" : "False") << ";" << endl;
+ indent(f_all) << "c" << tmp_unit << "_Option_Suppress_GUID = " << ( suppress_guid_ ? "True" : "False") << ";" << endl << endl;
+ indent_down();
+
+ f_all << "type" << endl;
+ f_all << s_forward_decr.str();
+ if (has_enum) {
+ indent(f_all) << endl;
+ indent(f_all) << "{$SCOPEDENUMS ON}" << endl << endl;
+ f_all << s_enum.str();
+ indent(f_all) << "{$SCOPEDENUMS OFF}" << endl << endl;
+ }
+ f_all << s_struct.str();
+ f_all << s_service.str();
+ f_all << s_const.str();
+ f_all << "implementation" << endl << endl;
+ f_all << s_struct_impl.str();
+ f_all << s_service_impl.str();
+ f_all << s_const_impl.str();
+
+ if ( has_const ) {
+ f_all << "{$IF CompilerVersion < 21.0}" << endl;
+ f_all << "initialization" << endl;
+ f_all << "begin" << endl;
+ f_all << " TConstants_Initialize;" << endl;
+ f_all << "end;" << endl << endl;
+
+ f_all << "finalization" << endl;
+ f_all << "begin" << endl;
+ f_all << " TConstants_Finalize;" << endl;
+ f_all << "end;" << endl;
+ f_all << "{$IFEND}" << endl << endl;
+ }
+ f_all << "end." << endl;
+ f_all.close();
+}
+
+void t_delphi_generator::delphi_type_usings( ostream& out) {
+ indent_up();
+ indent(out) << "Classes, SysUtils, Generics.Collections, Thrift.Collections, Thrift.Protocol," << endl;
+ indent(out) << "Thrift.Transport;" << endl << endl;
+ indent_down();
+}
+
+void t_delphi_generator::generate_typedef(t_typedef* ttypedef) {
+ (void) ttypedef;
+}
+
+void t_delphi_generator::generate_enum(t_enum* tenum) {
+ has_enum = true;
+ indent_up();
+ indent(s_enum) <<
+ type_name(tenum,true,true) << " = " << "(" << endl;
+ indent_up();
+ vector<t_enum_value*> constants = tenum->get_constants();
+ vector<t_enum_value*>::iterator c_iter;
+ for (c_iter = constants.begin(); c_iter != constants.end(); ++c_iter) {
+ int value = (*c_iter)->get_value();
+ if (c_iter != constants.begin()) {
+ s_enum << ",";
+ s_enum << endl;
+ }
+ indent(s_enum) << normalize_name((*c_iter)->get_name()) << " = " << value;
+ }
+ s_enum << endl;
+ indent_down();
+ indent(s_enum) << ");" << endl << endl;
+ indent_down();
+}
+
+void t_delphi_generator::generate_consts(std::vector<t_const*> consts) {
+ if (consts.empty()){
+ return;
+ }
+
+ has_const = true;
+
+ indent_up();
+ indent(s_const) <<
+ "TConstants = class" << endl;
+ indent(s_const) << "private" << endl;
+ indent_up();
+ vector<t_const*>::iterator c_iter;
+ for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) {
+ print_private_field(s_const, normalize_name((*c_iter)->get_name()),
+ (*c_iter)->get_type(), (*c_iter)->get_value());
+ }
+ indent_down();
+ indent(s_const) << "public" << endl;
+ indent_up();
+ for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) {
+ print_const_prop(s_const, normalize_name((*c_iter)->get_name()),
+ (*c_iter)->get_type(), (*c_iter)->get_value());
+ }
+ indent(s_const) << "{$IF CompilerVersion >= 21.0}" << endl;
+ indent(s_const) << "class constructor Create;" << endl;
+ indent(s_const) << "class destructor Destroy;" << endl;
+ indent(s_const) << "{$IFEND}" << endl;
+ indent_down();
+ indent(s_const) << "end;" << endl << endl;
+ indent_down();
+
+ std::ostringstream vars, code;
+
+ indent_up_impl();
+ for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) {
+ initialize_field(vars, code, "F" + prop_name( (*c_iter)->get_name()),
+ (*c_iter)->get_type(), (*c_iter)->get_value());
+ }
+ indent_down_impl();
+
+ indent_impl(s_const_impl) << "{$IF CompilerVersion >= 21.0}" << endl;
+ indent_impl(s_const_impl) << "class constructor TConstants.Create;" << endl;
+
+ if ( ! vars.str().empty() ) {
+ indent_impl(s_const_impl) << "var" << endl;
+ s_const_impl << vars.str();
+ }
+ indent_impl(s_const_impl) << "begin" << endl;
+ if ( ! code.str().empty() ) {
+ s_const_impl << code.str();
+ }
+ indent_impl(s_const_impl) << "end;" << endl << endl;
+ indent_impl(s_const_impl) << "class destructor TConstants.Destroy;" << endl;
+ indent_impl(s_const_impl) << "begin" << endl;
+ indent_up_impl();
+ for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) {
+ finalize_field(s_const_impl, normalize_name( (*c_iter)->get_name()),
+ (*c_iter)->get_type(), (*c_iter)->get_value());
+ }
+ indent_impl(s_const_impl) << "inherited;" << endl;
+ indent_down_impl();
+ indent_impl(s_const_impl) << "end;" << endl;
+ indent_impl(s_const_impl) << "{$ELSE}" << endl;
+
+ vars.str("");
+ code.str("");
+
+ indent_up_impl();
+ for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) {
+ initialize_field( vars, code, "F" + prop_name( (*c_iter)->get_name()),
+ (*c_iter)->get_type(), (*c_iter)->get_value(), "TConstants" );
+ }
+ indent_down_impl();
+
+ indent_impl(s_const_impl) << "procedure TConstants_Initialize;" << endl;
+ if ( ! vars.str().empty() ) {
+ indent_impl(s_const_impl) << "var" << endl;
+ s_const_impl << vars.str();
+ }
+ indent_impl(s_const_impl) << "begin" << endl;
+ if ( ! code.str().empty() ) {
+ s_const_impl << code.str();
+ }
+ indent_impl(s_const_impl) << "end;" << endl << endl;
+
+ indent_impl(s_const_impl) << "procedure TConstants_Finalize;" << endl;
+ indent_impl(s_const_impl) << "begin" << endl;
+ indent_up_impl();
+ for (c_iter = consts.begin(); c_iter != consts.end(); ++c_iter) {
+ finalize_field(s_const_impl, normalize_name( (*c_iter)->get_name()),
+ (*c_iter)->get_type(), (*c_iter)->get_value(), "TConstants" );
+ }
+ indent_down_impl();
+ indent_impl(s_const_impl) << "end;" << endl;
+ indent_impl(s_const_impl) << "{$IFEND}" << endl << endl;
+}
+
+void t_delphi_generator::print_const_def_value(std::ostream& vars, std::ostream& out, string name, t_type* type, t_const_value* value, string cls_nm)
+{
+
+ string cls_prefix;
+
+ if (cls_nm == "") {
+ cls_prefix = "";
+ } else {
+ cls_prefix = cls_nm + ".";
+ }
+
+ if (type->is_struct() || type->is_xception()) {
+ const vector<t_field*>& fields = ((t_struct*)type)->get_members();
+ vector<t_field*>::const_iterator f_iter;
+ const map<t_const_value*, t_const_value*>& val = value->get_map();
+ map<t_const_value*, t_const_value*>::const_iterator v_iter;
+ for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
+ t_type* field_type = NULL;
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ if ((*f_iter)->get_name() == v_iter->first->get_string()) {
+ field_type = (*f_iter)->get_type();
+ }
+ }
+ if (field_type == NULL) {
+ throw "type error: " + type->get_name() + " has no field " + v_iter->first->get_string();
+ }
+ string val = render_const_value( vars, out, name, field_type, v_iter->second);
+ indent_impl(out) << cls_prefix << normalize_name(name) << "." << normalize_name( v_iter->first->get_string()) << " := " << val << ";" << endl;
+ }
+ } else if (type->is_map()) {
+ t_type* ktype = ((t_map*)type)->get_key_type();
+ t_type* vtype = ((t_map*)type)->get_val_type();
+ const map<t_const_value*, t_const_value*>& val = value->get_map();
+ map<t_const_value*, t_const_value*>::const_iterator v_iter;
+ for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
+ string key = render_const_value( vars, out, name, ktype, v_iter->first);
+ string val = render_const_value( vars, out, name, vtype, v_iter->second);
+ indent_impl(out) << cls_prefix << normalize_name(name) << "[" << key << "]" << " := " << val << ";" << endl;
+ }
+ } else if (type->is_list() || type->is_set()) {
+ t_type* etype;
+ if (type->is_list()) {
+ etype = ((t_list*)type)->get_elem_type();
+ } else {
+ etype = ((t_set*)type)->get_elem_type();
+ }
+
+ const vector<t_const_value*>& val = value->get_list();
+ vector<t_const_value*>::const_iterator v_iter;
+ for (v_iter = val.begin(); v_iter != val.end(); ++v_iter) {
+ string val = render_const_value( vars, out, name, etype, *v_iter);
+ indent_impl(out) << cls_prefix << normalize_name(name) << ".Add(" << val << ");" << endl;
+ }
+ }
+}
+
+void t_delphi_generator::print_private_field(std::ostream& out, string name, t_type* type, t_const_value* value) {
+ indent(out) << "class var F" << name << ": " << type_name(type) << ";" << endl;
+}
+
+void t_delphi_generator::print_const_prop(std::ostream& out, string name, t_type* type, t_const_value* value) {
+ indent(out) << "class property " << name << ": " << type_name(type) << " read F" << name << ";" << endl;
+}
+
+void t_delphi_generator::print_const_value( std::ostream& vars, std::ostream& out, string name, t_type* type, t_const_value* value) {
+ t_type* truetype = type;
+ while (truetype->is_typedef()) {
+ truetype = ((t_typedef*)truetype)->get_type();
+ }
+
+ if (truetype->is_base_type()) {
+ string v2 = render_const_value( vars, out, name, type, value);
+ indent_impl(out) << name << " := " << v2 << ";" << endl;
+ } else if (truetype->is_enum()) {
+ indent_impl(out) << name << " := " << type_name(type) << "(" << value->get_integer() << ");" << endl;
+ } else {
+ string typname;
+ typname = type_name(type,!type->is_xception());
+ indent_impl(out) << name << " := " << typname << ".Create;" << endl;
+ print_const_def_value( vars, out, name, type, value);
+ }
+
+}
+
+void t_delphi_generator::initialize_field(std::ostream& vars, std::ostream& out, string name, t_type* type, t_const_value* value, string cls_nm) {
+ print_const_value( vars, out, name, type, value );
+}
+
+void t_delphi_generator::finalize_field(std::ostream& out, string name, t_type* type, t_const_value* value , string cls_nm) {
+}
+
+string t_delphi_generator::render_const_value(ostream& vars, ostream& out, string name, t_type* type, t_const_value* value) {
+
+ t_type* truetype = type;
+ while (truetype->is_typedef()) {
+ truetype = ((t_typedef*)truetype)->get_type();
+ }
+
+ std::ostringstream render;
+
+ if (truetype->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)truetype)->get_base();
+ switch (tbase) {
+ case t_base_type::TYPE_STRING:
+ render << "'" << get_escaped_string(value) << "'";
+ break;
+ case t_base_type::TYPE_BOOL:
+ render << ((value->get_integer() > 0) ? "True" : "False");
+ break;
+ case t_base_type::TYPE_BYTE:
+ case t_base_type::TYPE_I16:
+ case t_base_type::TYPE_I32:
+ case t_base_type::TYPE_I64:
+ render << value->get_integer();
+ break;
+ case t_base_type::TYPE_DOUBLE:
+ if (value->get_type() == t_const_value::CV_INTEGER) {
+ render << value->get_integer();
+ } else {
+ render << value->get_double();
+ }
+ break;
+ default:
+ render << "";
+ }
+ } else if (truetype->is_enum()) {
+ render << type_name( type, false) << "(" << value->get_integer() << ")";
+ } else {
+ string t = tmp("tmp");
+ vars << " " << t << " : " << type_name(type) << ";" << endl;
+ print_const_value( vars, out, t, type, value);
+ render << t;
+ }
+
+ return render.str();
+}
+
+void t_delphi_generator::generate_struct(t_struct* tstruct) {
+ generate_delphi_struct(tstruct, false);
+}
+
+void t_delphi_generator::generate_xception(t_struct* txception) {
+ generate_delphi_struct(txception, true);
+}
+
+void t_delphi_generator::generate_delphi_struct(t_struct* tstruct, bool is_exception) {
+ indent_up();
+ generate_delphi_struct_definition(s_struct, tstruct, is_exception);
+ indent_down();
+
+ generate_delphi_struct_impl(s_struct_impl, "", tstruct, is_exception);
+
+}
+
+void t_delphi_generator::generate_delphi_struct_impl( ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception, bool is_result, bool is_x_factory) {
+
+ if (is_exception && (! is_x_factory)) {
+ generate_delphi_struct_impl( out, cls_prefix, tstruct, is_exception, is_result, true);
+ }
+
+ string cls_nm;
+
+ string exception_factory_name;
+
+ if (is_exception) {
+ exception_factory_name = normalize_clsnm( tstruct->get_name(), "", true ) + "Factory";
+ }
+
+ if (is_exception) {
+ cls_nm = type_name(tstruct,true,(! is_x_factory),is_x_factory,true);
+ }
+ else {
+ cls_nm = type_name(tstruct,true,false);
+ }
+
+ std::ostringstream vars, code;
+
+ const vector<t_field*>& members = tstruct->get_members();
+ vector<t_field*>::const_iterator m_iter;
+
+ indent_up_impl();
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ t_type* t = (*m_iter)->get_type();
+ while (t->is_typedef()) {
+ t = ((t_typedef*)t)->get_type();
+ }
+ if ((*m_iter)->get_value() != NULL) {
+ initialize_field( vars, code, "F" + prop_name( (*m_iter)->get_name(), is_exception), t, (*m_iter)->get_value());
+ }
+ }
+ indent_down_impl();
+
+
+ indent_impl(out) << "constructor " << cls_prefix << cls_nm << "." << "Create;" << endl;
+
+ if ( ! vars.str().empty()) {
+ out << vars.str();
+ }
+
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+ if (is_exception && (! is_x_factory)) {
+ indent_impl(out) << "inherited Create('');" << endl;
+ indent_impl(out) << "F" << exception_factory_name << " := T" << exception_factory_name << "Impl.Create;" << endl;
+ } else {
+ indent_impl(out) << "inherited;" << endl;
+ }
+
+ if ( ! code.str().empty()) {
+ out << code.str();
+ }
+
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl << endl;
+
+ indent_impl(out) << "destructor " << cls_prefix << cls_nm << "." << "Destroy;" << endl;
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ t_type* t = (*m_iter)->get_type();
+ while (t->is_typedef()) {
+ t = ((t_typedef*)t)->get_type();
+ }
+ finalize_field( out, prop_name(*m_iter, is_exception), t, (*m_iter)->get_value());
+ }
+
+ indent_impl(out) << "inherited;" << endl;
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl << endl;
+
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ t_type* t = (*m_iter)->get_type();
+ while (t->is_typedef()) {
+ t = ((t_typedef*)t)->get_type();
+ }
+ generate_delphi_property_reader_impl( out, cls_prefix, cls_nm, t, *m_iter, "F");
+ generate_delphi_property_writer_impl( out, cls_prefix, cls_nm, t, *m_iter, "F", (is_exception && (! is_x_factory)), exception_factory_name);
+ generate_delphi_isset_reader_impl( out, cls_prefix, cls_nm, t, *m_iter, "F");
+ }
+
+ if ((! is_exception) || is_x_factory) {
+ generate_delphi_struct_reader_impl( out, cls_prefix, tstruct, is_exception);
+ if ( is_result ) {
+ generate_delphi_struct_result_writer_impl( out, cls_prefix, tstruct, is_exception);
+ } else {
+ generate_delphi_struct_writer_impl( out, cls_prefix, tstruct, is_exception);
+ }
+ generate_delphi_struct_tostring_impl( out, cls_prefix, tstruct, is_exception);
+ }
+
+ if (is_exception && is_x_factory) {
+ generate_delphi_create_exception_impl( out, cls_prefix, tstruct, is_exception);
+ }
+}
+
+void t_delphi_generator::generate_delphi_struct_definition(ostream &out, t_struct* tstruct, bool is_exception, bool in_class, bool is_result, bool is_x_factory) {
+ bool is_final = (tstruct->annotations_.find("final") != tstruct->annotations_.end());
+ string struct_intf_name;
+ string struct_name;
+ string isset_name;
+ const vector<t_field*>& members = tstruct->get_members();
+ vector<t_field*>::const_iterator m_iter;
+
+ string exception_factory_name = normalize_clsnm( tstruct->get_name(), "", true ) + "Factory";
+
+ if (is_exception) {
+ struct_intf_name = type_name(tstruct,false,false,true);
+ }
+ else {
+ struct_intf_name = type_name(tstruct);
+ }
+
+
+ if (is_exception) {
+ struct_name = type_name(tstruct, true, (! is_x_factory), is_x_factory);
+ }
+ else {
+ struct_name = type_name(tstruct,true);
+ }
+
+ if ((! is_exception) || is_x_factory) {
+
+ indent(out) << struct_intf_name << " = interface(IBase)" << endl;
+ indent_up();
+
+ if (! suppress_guid_) {
+ indent(out) << generate_guid() << endl;
+ }
+
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ generate_delphi_property_reader_definition( out, *m_iter);
+ generate_delphi_property_writer_definition( out, *m_iter);
+ }
+
+ if (is_x_factory) {
+ out << endl;
+ indent(out) << "// Create Exception Object" << endl;
+ indent(out) << "function CreateException: " << type_name(tstruct,true,true) << ";" << endl;
+ }
+
+ if (members.size() > 0) {
+ out << endl;
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ generate_property(out, *m_iter, true, is_exception);
+ }
+ }
+
+ if (members.size() > 0) {
+ out << endl;
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ generate_delphi_isset_reader_definition( out, *m_iter);
+ }
+ }
+
+ if (members.size() > 0) {
+ out << endl;
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ isset_name = "__isset_" + prop_name(*m_iter, is_exception);
+ indent(out) << "property " << isset_name << ": Boolean read Get" << isset_name << ";" << endl;
+ }
+ }
+
+ indent_down();
+ indent(out) << "end;" << endl << endl;
+ }
+
+ indent(out) << struct_name << " = ";
+ if (is_final) {
+ out << "sealed ";
+ }
+ out << "class(";
+ if ( is_exception && (! is_x_factory)) {
+ out << "Exception";
+ } else {
+ out << "TInterfacedObject, IBase, " << struct_intf_name;
+ }
+ out << ")" << endl;
+
+ if (is_exception && (! is_x_factory)) {
+ indent(out) << "public" << endl;
+ indent_up();
+ indent(out) << "type" << endl;
+ indent_up();
+ generate_delphi_struct_definition( out, tstruct, is_exception, in_class, is_result, true);
+ indent_down();
+ indent_down();
+ }
+
+ indent(out) << "private" << endl;
+ indent_up();
+
+ if (is_exception && (! is_x_factory)) {
+ indent(out) << "F" << exception_factory_name << " :" << struct_intf_name << ";" << endl << endl;
+ }
+
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ indent(out) << declare_field(*m_iter, false, "F") << endl;
+ }
+
+ if (members.size() > 0) {
+ indent(out) << endl;
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ isset_name = "F__isset_" + prop_name(*m_iter, is_exception);
+ indent(out) << isset_name << ": Boolean;" << endl;
+ }
+ }
+
+ indent(out) << endl;
+
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ generate_delphi_property_reader_definition( out, *m_iter);
+ generate_delphi_property_writer_definition( out, *m_iter);
+ }
+
+ if (members.size() > 0) {
+ out << endl;
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ isset_name = "__isset_" + prop_name(*m_iter, is_exception);
+ indent(out) << "function Get" << isset_name << ": Boolean;" << endl;
+ }
+ }
+
+ indent_down();
+
+ indent(out) << "public" << endl;
+ indent_up();
+
+ indent(out) << "constructor Create;" << endl;
+ indent(out) << "destructor Destroy; override;" << endl;
+
+ if ((! is_exception) || is_x_factory) {
+ out << endl;
+ indent(out) << "function ToString: string; override;" << endl;
+ }
+
+ if (is_exception && (! is_x_factory)) {
+ out << endl;
+ indent(out) << "// Exception Factory" << endl;
+ indent(out) << "property " << exception_factory_name << ": " << struct_intf_name << " read F" << exception_factory_name << " write F" << exception_factory_name << ";" << endl;
+ }
+
+ if ((! is_exception) || is_x_factory) {
+ out << endl;
+ indent(out) << "// IBase" << endl;
+ indent(out) << "procedure Read( iprot: IProtocol);" << endl;
+ indent(out) << "procedure Write( oprot: IProtocol);" << endl;
+ }
+
+ if (is_exception && is_x_factory) {
+ out << endl;
+ indent(out) << "// Create Exception Object" << endl;
+ indent(out) << "function CreateException: " << type_name(tstruct,true,true) << ";" << endl;
+ }
+
+ if (members.size() > 0) {
+ out << endl;
+ indent(out) << "// Properties" << endl;
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ generate_property(out, *m_iter, true, is_exception);
+ }
+ }
+
+ if (members.size() > 0) {
+ out << endl;
+ indent(out) << "// isset" << endl;
+ for (m_iter = members.begin(); m_iter != members.end(); ++m_iter) {
+ isset_name = "__isset_" + prop_name(*m_iter, is_exception);
+ indent(out) << "property " << isset_name << ": Boolean read Get" << isset_name << ";" << endl;
+ }
+ }
+
+ indent_down();
+ indent(out) << "end;" << endl;
+
+ indent(out) << endl;
+}
+
+void t_delphi_generator::generate_service(t_service* tservice) {
+ indent_up();
+ indent(s_service) << normalize_clsnm(service_name_, "T") << " = class" << endl;
+ indent(s_service) << "public" << endl;
+ indent_up();
+ indent(s_service) << "type" << endl;
+ generate_service_interface(tservice);
+ generate_service_client(tservice);
+ generate_service_server(tservice);
+ generate_service_helpers(tservice);
+ indent_down();
+ indent_down();
+ indent(s_service) << "end;" << endl;
+ indent(s_service) << endl;
+ indent_down();
+}
+
+void t_delphi_generator::generate_service_interface(t_service* tservice) {
+ string extends = "";
+ string extends_iface = "";
+
+ indent_up();
+
+ if (tservice->get_extends() != NULL) {
+ extends = type_name(tservice->get_extends(), true, true);
+ extends_iface = extends + ".Iface";
+ indent(s_service) <<
+ "Iface = interface(" << extends_iface << ")" << endl;
+ } else {
+ indent(s_service) <<
+ "Iface = interface" << endl;
+ }
+
+ indent_up();
+
+ if (! suppress_guid_) {
+ indent(s_service) << generate_guid() << endl;
+ }
+
+ vector<t_function*> functions = tservice->get_functions();
+ vector<t_function*>::iterator f_iter;
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter)
+ {
+ indent(s_service) <<
+ function_signature(*f_iter) << endl;
+ }
+ indent_down();
+ indent(s_service) << "end;" << endl << endl;
+
+ indent_down();
+}
+
+void t_delphi_generator::generate_service_helpers(t_service* tservice) {
+ vector<t_function*> functions = tservice->get_functions();
+ vector<t_function*>::iterator f_iter;
+
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+ t_struct* ts = (*f_iter)->get_arglist();
+ generate_delphi_struct_definition(s_service, ts, false, true);
+ generate_delphi_struct_impl(s_service_impl, normalize_clsnm( service_name_, "T") + ".", ts, false);
+ generate_function_helpers(*f_iter);
+ }
+}
+
+void t_delphi_generator::generate_service_client(t_service* tservice) {
+ indent_up();
+ string extends = "";
+ string extends_client = "";
+ if (tservice->get_extends() != NULL) {
+ extends = type_name(tservice->get_extends());
+ extends_client = extends + ".Client, ";
+ }
+
+ if (tservice->get_extends() != NULL) {
+ extends = type_name(tservice->get_extends(), true, true);
+ extends_client = extends + ".TClient";
+ indent(s_service) <<
+ "TClient = class(" << extends_client << ", Iface)" << endl;
+ } else {
+ indent(s_service) <<
+ "TClient = class( TInterfacedObject, Iface)" << endl;
+ }
+
+ indent(s_service) << "public" << endl;
+ indent_up();
+
+ indent(s_service) << "constructor Create( prot: IProtocol); overload;" << endl;
+
+ indent_impl(s_service_impl) << "constructor " << normalize_clsnm( service_name_, "T") << ".TClient.Create( prot: IProtocol);" << endl;
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "Create( prot, prot );" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl << endl;
+
+ indent(s_service) << "constructor Create( iprot: IProtocol; oprot: IProtocol); overload;" << endl;
+
+ indent_impl(s_service_impl) << "constructor " << normalize_clsnm( service_name_, "T") << ".TClient.Create( iprot: IProtocol; oprot: IProtocol);" << endl;
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "iprot_ := iprot;" << endl;
+ indent_impl(s_service_impl) << "oprot_ := oprot;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl << endl;
+
+ indent_down();
+
+ if (extends.empty()) {
+ indent(s_service) << "protected" << endl;
+ indent_up();
+ indent(s_service) << "iprot_: IProtocol;" << endl;
+ indent(s_service) << "oprot_: IProtocol;" << endl;
+ indent(s_service) << "seqid_: Integer;" << endl;
+ indent_down();
+
+ indent(s_service) << "public" << endl;
+ indent_up();
+ indent(s_service) << "property InputProtocol: IProtocol read iprot_;" << endl;
+ indent(s_service) << "property OutputProtocol: IProtocol read oprot_;" << endl;
+ indent_down();
+ }
+
+ vector<t_function*> functions = tservice->get_functions();
+ vector<t_function*>::const_iterator f_iter;
+
+ indent(s_service) << "protected" << endl;
+ indent_up();
+ indent(s_service) << "// Iface" << endl;
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+ string funname = (*f_iter)->get_name();
+ indent(s_service) << function_signature(*f_iter) << endl;
+ }
+ indent_down();
+
+ indent(s_service) << "public" << endl;
+ indent_up();
+
+ string full_cls = normalize_clsnm(service_name_,"T") + ".TClient";
+
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+ string funname = (*f_iter)->get_name();
+
+ indent_impl(s_service_impl) << function_signature(*f_iter, full_cls) << endl;
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "send_" << funname << "(";
+
+ t_struct* arg_struct = (*f_iter)->get_arglist();
+
+ const vector<t_field*>& fields = arg_struct->get_members();
+ vector<t_field*>::const_iterator fld_iter;
+ bool first = true;
+ for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
+ if (first) {
+ first = false;
+ } else {
+ s_service_impl << ", ";
+ }
+ s_service_impl << normalize_name( (*fld_iter)->get_name());
+ }
+ s_service_impl << ");" << endl;
+
+ if (!(*f_iter)->is_oneway()) {
+ s_service_impl << indent_impl();
+ if (!(*f_iter)->get_returntype()->is_void()) {
+ s_service_impl << "Result := ";
+ }
+ s_service_impl <<
+ "recv_" << funname << "();" << endl;
+ }
+
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl << endl;
+
+ t_function send_function(g_type_void,
+ string("send_") + (*f_iter)->get_name(),
+ (*f_iter)->get_arglist());
+
+ string argsname = (*f_iter)->get_name() + "_args";
+ string args_clsnm = normalize_clsnm( argsname, "T");
+ string args_intfnm= normalize_clsnm( argsname, "I");
+
+ indent(s_service) << function_signature(&send_function) << endl;
+ indent_impl(s_service_impl) << function_signature(&send_function, full_cls) << endl;
+ indent_impl(s_service_impl) << "var" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "args : " << args_intfnm << ";" << endl;
+ indent_impl(s_service_impl) << "msg : IMessage;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+
+ indent_impl(s_service_impl) <<
+ "seqid_ := seqid_ + 1;" << endl;
+ indent_impl(s_service_impl) <<
+ "msg := TMessageImpl.Create('" << funname << "', TMessageType.Call, seqid_);" << endl;
+
+ indent_impl(s_service_impl) <<
+ "oprot_.WriteMessageBegin( msg );" << endl;
+ indent_impl(s_service_impl) <<
+ "args := " << args_clsnm << "Impl.Create();" << endl;
+
+ for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
+ indent_impl(s_service_impl) <<
+ "args." << prop_name(*fld_iter) << " := " << normalize_name( (*fld_iter)->get_name()) << ";" << endl;
+ }
+ indent_impl(s_service_impl) << "args.Write(oprot_);" << endl;
+ for (fld_iter = fields.begin(); fld_iter != fields.end(); ++fld_iter) {
+ indent_impl(s_service_impl) <<
+ "args." << prop_name(*fld_iter) << " := " << empty_value((*fld_iter)->get_type()) << ";" << endl;
+ }
+
+ indent_impl(s_service_impl) << "oprot_.WriteMessageEnd();" << endl;
+ indent_impl(s_service_impl) << "oprot_.Transport.Flush();" << endl;
+
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl << endl;
+
+ if (!(*f_iter)->is_oneway()) {
+ string org_resultname = (*f_iter)->get_name() + "_result" ;
+ string result_clsnm = normalize_clsnm( org_resultname, "T");
+ string result_intfnm = normalize_clsnm( org_resultname, "I");
+
+ t_struct noargs(program_);
+ t_function recv_function((*f_iter)->get_returntype(),
+ string("recv_") + (*f_iter)->get_name(),
+ &noargs,
+ (*f_iter)->get_xceptions());
+
+ t_struct *xs = (*f_iter)->get_xceptions();
+ const std::vector<t_field*>& xceptions = xs->get_members();
+
+ indent(s_service) << function_signature(&recv_function) << endl;
+ indent_impl(s_service_impl) << function_signature(&recv_function, full_cls) << endl;
+ indent_impl(s_service_impl) << "var" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "msg : IMessage;" << endl;
+ if ( xceptions.size() > 0) {
+ indent_impl(s_service_impl) << "ex : Exception;" << endl;
+ }
+ indent_impl(s_service_impl) << "x : TApplicationException;" << endl;
+ indent_impl(s_service_impl) << "ret : " << result_intfnm << ";" << endl;
+
+ indent_down_impl();
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "msg := iprot_.ReadMessageBegin();" << endl;
+ indent_impl(s_service_impl) << "if (msg.Type_ = TMessageType.Exception) then" << endl;
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "x := TApplicationException.Read(iprot_);" << endl;
+ indent_impl(s_service_impl) << "iprot_.ReadMessageEnd();" << endl;
+ indent_impl(s_service_impl) << "raise x;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl;
+
+ indent_impl(s_service_impl) << "ret := " << result_clsnm << "Impl.Create();" << endl;
+ indent_impl(s_service_impl) << "ret.Read(iprot_);" << endl;
+ indent_impl(s_service_impl) << "iprot_.ReadMessageEnd();" << endl;
+
+ if (!(*f_iter)->get_returntype()->is_void()) {
+ indent_impl(s_service_impl) << "if (ret.__isset_success) then" << endl;
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "Result := ret.Success;" << endl;
+ t_type *type = (*f_iter)->get_returntype();
+ if (type->is_struct() || type->is_xception() || type->is_map() || type->is_list() || type->is_set()) {
+ indent_impl(s_service_impl) << "ret.Success := nil;" << endl;
+ }
+ indent_impl(s_service_impl) << "Exit;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl;
+ }
+
+ vector<t_field*>::const_iterator x_iter;
+ for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
+ indent_impl(s_service_impl) << "if (ret.__isset_" << prop_name(*x_iter) << ") then" << endl;
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "ex := ret." << prop_name(*x_iter) << ".CreateException;" << endl;
+ indent_impl(s_service_impl) << "raise ex;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl;
+ }
+
+ if (!(*f_iter)->get_returntype()->is_void()) {
+ indent_impl(s_service_impl) <<
+ "raise TApplicationException.Create(TApplicationException.TExceptionType.MissingResult, '" << (*f_iter)->get_name() << " failed: unknown result');" << endl;
+ }
+
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl << endl;
+ }
+ }
+
+ indent_down();
+ indent(s_service) << "end;" << endl << endl;
+}
+
+void t_delphi_generator::generate_service_server(t_service* tservice) {
+ vector<t_function*> functions = tservice->get_functions();
+ vector<t_function*>::iterator f_iter;
+
+ string extends = "";
+ string extends_processor = "";
+
+ string full_cls = normalize_clsnm( service_name_, "T") + ".TProcessorImpl";
+
+ if (tservice->get_extends() != NULL) {
+ extends = type_name(tservice->get_extends(), true, true);
+ extends_processor = extends + ".TProcessorImpl";
+ indent(s_service) <<
+ "TProcessorImpl = class(" << extends_processor << ", IProcessor)" << endl;
+ } else {
+ indent(s_service) <<
+ "TProcessorImpl = class( TInterfacedObject, IProcessor)" << endl;
+ }
+
+ indent(s_service) << "public" << endl;
+ indent_up();
+ indent(s_service) << "constructor Create( iface_: Iface );" << endl;
+ indent(s_service) << "destructor Destroy; override;" << endl;
+ indent_down();
+
+ indent_impl(s_service_impl) << "constructor " << full_cls << ".Create( iface_: Iface );" << endl;
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "Self.iface_ := iface_;" << endl;
+ indent_impl(s_service_impl) << "processMap_ := TThriftDictionaryImpl<string, TProcessFunction>.Create;" << endl;
+
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter) {
+ indent_impl(s_service_impl) <<
+ "processMap_.AddOrSetValue( '" << (*f_iter)->get_name() << "', " << (*f_iter)->get_name() << "_Process);" << endl;
+ }
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl << endl;
+
+ indent_impl(s_service_impl) << "destructor " << full_cls << ".Destroy;" << endl;
+ indent_impl(s_service_impl) << "begin;" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "inherited;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl << endl;
+
+ indent(s_service) << "protected" << endl;
+ indent_up();
+ indent(s_service) << "type" << endl;
+ indent_up();
+ indent(s_service) << "TProcessFunction = reference to procedure( seqid: Integer; iprot: IProtocol; oprot: IProtocol);" << endl;
+ indent_down();
+ indent_down();
+
+ indent(s_service) << "private" << endl;
+ indent_up();
+ indent(s_service) << "iface_: Iface;" << endl;
+ indent_down();
+ indent(s_service) << "protected" << endl;
+ indent_up();
+ indent(s_service) << "processMap_: IThriftDictionary<string, TProcessFunction>;" << endl;
+ indent_down();
+ indent(s_service) << "public" << endl;
+ indent_up();
+ if (extends.empty()) {
+ indent(s_service) << "function Process( iprot: IProtocol; oprot: IProtocol): Boolean;" << endl;
+ } else {
+ indent(s_service) << "function Process( iprot: IProtocol; oprot: IProtocol): Boolean; reintroduce;" << endl;
+ }
+
+ indent_impl(s_service_impl) << "function " << full_cls << ".Process( iprot: IProtocol; oprot: IProtocol): Boolean;" << endl;;
+ indent_impl(s_service_impl) << "var" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "msg : IMessage;" << endl;
+ indent_impl(s_service_impl) << "fn : TProcessFunction;" << endl;
+ indent_impl(s_service_impl) << "x : TApplicationException;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "try" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "msg := iprot.ReadMessageBegin();" << endl;
+ indent_impl(s_service_impl) << "fn := nil;" << endl;
+ indent_impl(s_service_impl) << "processMap_.TryGetValue(msg.Name, fn);" << endl;
+ indent_impl(s_service_impl) << "if (@fn = nil) then" << endl;
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "TProtocolUtil.Skip(iprot, TType.Struct);" << endl;
+ indent_impl(s_service_impl) << "iprot.ReadMessageEnd();" << endl;
+ indent_impl(s_service_impl) << "x := TApplicationException.Create(TApplicationException.TExceptionType.UnknownMethod, 'Invalid method name: ''' + msg.Name + '''');" << endl;
+ indent_impl(s_service_impl) << "oprot.WriteMessageBegin(TMessageImpl.Create(msg.Name, TMessageType.Exception, msg.SeqID));" << endl;
+ indent_impl(s_service_impl) << "x.Write(oprot);" << endl;
+ indent_impl(s_service_impl) << "oprot.WriteMessageEnd();" << endl;
+ indent_impl(s_service_impl) << "oprot.Transport.Flush();" << endl;
+ indent_impl(s_service_impl) << "Result := True;" << endl;
+ indent_impl(s_service_impl) << "Exit;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl;
+ indent_impl(s_service_impl) << "fn(msg.SeqID, iprot, oprot);" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "except" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "Result := False;" << endl;
+ indent_impl(s_service_impl) << "Exit;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl;
+ indent_impl(s_service_impl) << "Result := True;" << endl;
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl << endl;
+
+ for (f_iter = functions.begin(); f_iter != functions.end(); ++f_iter)
+ {
+ generate_process_function(tservice, *f_iter);
+ }
+
+ indent_down();
+ indent(s_service) << "end;" << endl << endl;
+
+}
+
+void t_delphi_generator::generate_function_helpers(t_function* tfunction) {
+ if (tfunction->is_oneway()) {
+ return;
+ }
+
+ t_struct result(program_, tfunction->get_name() + "_result");
+ t_field success(tfunction->get_returntype(), "Success", 0);
+ if (!tfunction->get_returntype()->is_void()) {
+ result.append(&success);
+ }
+
+ t_struct *xs = tfunction->get_xceptions();
+ const vector<t_field*>& fields = xs->get_members();
+ vector<t_field*>::const_iterator f_iter;
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ result.append(*f_iter);
+ }
+
+ generate_delphi_struct_definition(s_service, &result, false, true, true);
+ generate_delphi_struct_impl(s_service_impl, normalize_clsnm( service_name_, "T") + ".", &result, false);
+}
+
+void t_delphi_generator::generate_process_function(t_service* tservice, t_function* tfunction) {
+ (void) tservice;
+ string funcname = tfunction->get_name();
+ string full_cls = normalize_clsnm( service_name_, "T") + ".TProcessorImpl";
+
+ string org_argsname = funcname + "_args";
+ string args_clsnm = normalize_clsnm(org_argsname, "T");
+ string args_intfnm = normalize_clsnm(org_argsname, "I");
+
+ string org_resultname = funcname + "_result";
+ string result_clsnm = normalize_clsnm(org_resultname, "T");
+ string result_intfnm = normalize_clsnm(org_resultname, "I");
+
+ indent(s_service) <<
+ "procedure " << funcname << "_Process( seqid: Integer; iprot: IProtocol; oprot: IProtocol);" << endl;
+
+ if (tfunction->is_oneway()) {
+ indent_impl(s_service_impl) << "// one way processor" << endl;
+ } else {
+ indent_impl(s_service_impl) << "// both way processor" << endl;
+ }
+
+ indent_impl(s_service_impl) <<
+ "procedure " << full_cls << "." << funcname << "_Process( seqid: Integer; iprot: IProtocol; oprot: IProtocol);" << endl;
+ indent_impl(s_service_impl) << "var" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "args: " << args_intfnm << ";" << endl;
+ if (!tfunction->is_oneway()) {
+ indent_impl(s_service_impl) << "ret: " << result_intfnm << ";" << endl;
+ }
+
+ indent_down_impl();
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(s_service_impl) << "args := " << args_clsnm << "Impl.Create;" << endl;
+ indent_impl(s_service_impl) << "args.Read(iprot);" << endl;
+ indent_impl(s_service_impl) << "iprot.ReadMessageEnd();" << endl;
+
+ t_struct* xs = tfunction->get_xceptions();
+ const std::vector<t_field*>& xceptions = xs->get_members();
+ vector<t_field*>::const_iterator x_iter;
+
+ if (!tfunction->is_oneway()) {
+ indent_impl(s_service_impl) << "ret := " << result_clsnm << "Impl.Create;" << endl;
+ }
+
+ if (!tfunction->is_oneway() && xceptions.size() > 0) {
+ indent_impl(s_service_impl) << "try" << endl;
+ indent_up_impl();
+ }
+
+ t_struct* arg_struct = tfunction->get_arglist();
+ const std::vector<t_field*>& fields = arg_struct->get_members();
+ vector<t_field*>::const_iterator f_iter;
+
+ s_service_impl << indent_impl();
+ if (!tfunction->is_oneway() && !tfunction->get_returntype()->is_void()) {
+ s_service_impl << "ret.Success := ";
+ }
+ s_service_impl << "iface_." << normalize_name( tfunction->get_name(), true) << "(";
+ bool first = true;
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ if (first) {
+ first = false;
+ } else {
+ s_service_impl << ", ";
+ }
+ s_service_impl << "args." << prop_name(*f_iter);
+ }
+ s_service_impl << ");" << endl;
+
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ indent_impl(s_service_impl) <<
+ "args." << prop_name(*f_iter) << " := " << empty_value((*f_iter)->get_type()) << ";" << endl;
+ }
+
+ if (!tfunction->is_oneway() && xceptions.size() > 0) {
+ indent_down_impl();
+ indent_impl(s_service_impl) << "except" << endl;
+ indent_up_impl();
+ for (x_iter = xceptions.begin(); x_iter != xceptions.end(); ++x_iter) {
+ indent_impl(s_service_impl) << "on E: " << type_name((*x_iter)->get_type(),true,true) << " do" << endl;
+ indent_impl(s_service_impl) << "begin" << endl;
+ indent_up_impl();
+ if (!tfunction->is_oneway()) {
+ string factory_name = normalize_clsnm((*x_iter)->get_type()->get_name(),"",true) + "Factory";
+ indent_impl(s_service_impl) <<
+ "ret." << prop_name(*x_iter) << " := E." << factory_name << ";" << endl;
+ }
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl;
+ }
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl;
+ }
+
+ if (! tfunction->is_oneway()) {
+ indent_impl(s_service_impl) << "oprot.WriteMessageBegin( TMessageImpl.Create('" << tfunction->get_name() << "', TMessageType.Reply, seqid)); " << endl;
+ indent_impl(s_service_impl) << "ret.Write(oprot);" << endl;
+ indent_impl(s_service_impl) << "oprot.WriteMessageEnd();" << endl;
+ indent_impl(s_service_impl) << "oprot.Transport.Flush();" << endl;
+ }
+
+ indent_down_impl();
+ indent_impl(s_service_impl) << "end;" << endl << endl;
+}
+
+void t_delphi_generator::generate_deserialize_field(ostream& out, bool is_xception, t_field* tfield, string prefix, ostream& local_vars) {
+ t_type* type = tfield->get_type();
+ while(type->is_typedef()) {
+ type = ((t_typedef*)type)->get_type();
+ }
+
+ if (type->is_void()) {
+ throw "CANNOT GENERATE DESERIALIZE CODE FOR void TYPE: " + prefix + tfield->get_name();
+ }
+
+ string name = prefix + prop_name(tfield,is_xception);
+
+ if (type->is_struct() || type->is_xception()) {
+ generate_deserialize_struct(out, (t_struct*)type, name, "");
+ } else if (type->is_container()) {
+ generate_deserialize_container(out, is_xception, type, name, local_vars);
+ } else if (type->is_base_type() || type->is_enum()) {
+ indent_impl(out) <<
+ name << " := ";
+
+ if (type->is_enum())
+ {
+ out << type_name(type, false) << "(";
+ }
+
+ out << "iprot.";
+
+ if (type->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+ switch (tbase) {
+ case t_base_type::TYPE_VOID:
+ throw "compiler error: cannot serialize void field in a struct: " + name;
+ break;
+ case t_base_type::TYPE_STRING:
+ if (((t_base_type*)type)->is_binary()) {
+ if (ansistr_binary_) {
+ out << "ReadAnsiString();";
+ } else {
+ out << "ReadBinary();";
+ }
+ } else {
+ out << "ReadString();";
+ }
+ break;
+ case t_base_type::TYPE_BOOL:
+ out << "ReadBool();";
+ break;
+ case t_base_type::TYPE_BYTE:
+ out << "ReadByte();";
+ break;
+ case t_base_type::TYPE_I16:
+ out << "ReadI16();";
+ break;
+ case t_base_type::TYPE_I32:
+ out << "ReadI32();";
+ break;
+ case t_base_type::TYPE_I64:
+ out << "ReadI64();";
+ break;
+ case t_base_type::TYPE_DOUBLE:
+ out << "ReadDouble();";
+ break;
+ default:
+ throw "compiler error: no C# name for base type " + tbase;
+ }
+ } else if (type->is_enum()) {
+ out << "ReadI32()";
+ out << ");";
+ }
+ out << endl;
+ } else {
+ printf("DO NOT KNOW HOW TO DESERIALIZE FIELD '%s' TYPE '%s'\n", tfield->get_name().c_str(), type_name(type).c_str());
+ }
+}
+
+void t_delphi_generator::generate_deserialize_struct(ostream& out, t_struct* tstruct, string name, string prefix) {
+ string typ_name;
+
+ if (tstruct->is_xception()) {
+ typ_name = type_name(tstruct,true,false,true,true);
+ } else {
+ typ_name = type_name(tstruct,true,false);
+ }
+
+ indent_impl(out) << prefix << name << " := " << typ_name << ".Create;" << endl;
+ indent_impl(out) << prefix << name << ".Read(iprot);" << endl;
+}
+
+void t_delphi_generator::generate_deserialize_container(ostream& out, bool is_xception, t_type* ttype, string name, std::ostream& local_vars) {
+
+ string obj;
+ string counter;
+ string local_var;
+
+ if (ttype->is_map()) {
+ obj = tmp("_map");
+ } else if (ttype->is_set()) {
+ obj = tmp("_set");
+ } else if (ttype->is_list()) {
+ obj = tmp("_list");
+ }
+
+ if (ttype->is_map()) {
+ local_var = obj + ": IMap;";
+ } else if (ttype->is_set()) {
+ local_var = obj + ": ISet;";
+ } else if (ttype->is_list()) {
+ local_var = obj + ": IList;";
+ }
+ local_vars << " " << local_var << endl;
+ counter = tmp("_i");
+ local_var = counter + ": Integer;";
+ local_vars << " " << local_var << endl;
+
+ indent_impl(out) << name << " := " << type_name(ttype, true) << ".Create;" << endl;
+
+ if (ttype->is_map()) {
+ indent_impl(out) << obj << " := iprot.ReadMapBegin();" << endl;
+ } else if (ttype->is_set()) {
+ indent_impl(out) << obj << " := iprot.ReadSetBegin();" << endl;
+ } else if (ttype->is_list()) {
+ indent_impl(out) << obj << " := iprot.ReadListBegin();" << endl;
+ }
+
+ indent_impl(out) <<
+ "for " << counter << " := 0 to " << obj << ".Count - 1 do" << endl;
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+ if (ttype->is_map()) {
+ generate_deserialize_map_element(out, is_xception, (t_map*)ttype, name, local_vars);
+ } else if (ttype->is_set()) {
+ generate_deserialize_set_element(out, is_xception, (t_set*)ttype, name, local_vars);
+ } else if (ttype->is_list()) {
+ generate_deserialize_list_element(out, is_xception, (t_list*)ttype, name, local_vars);
+ }
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl;
+}
+
+void t_delphi_generator::generate_deserialize_map_element(ostream& out, bool is_xception, t_map* tmap, string prefix, ostream& local_vars) {
+
+ string key = tmp("_key");
+ string val = tmp("_val");
+ string local_var;
+
+ t_field fkey(tmap->get_key_type(), key);
+ t_field fval(tmap->get_val_type(), val);
+
+ local_vars << " " << declare_field(&fkey) << endl;
+ local_vars << " " << declare_field(&fval) << endl;
+
+ generate_deserialize_field(out, is_xception, &fkey, "", local_vars);
+ generate_deserialize_field(out, is_xception, &fval, "", local_vars);
+
+ indent_impl(out) <<
+ prefix << ".AddOrSetValue( " << key << ", " << val << ");" << endl;
+
+}
+
+void t_delphi_generator::generate_deserialize_set_element(ostream& out, bool is_xception, t_set* tset, string prefix, ostream& local_vars) {
+ string elem = tmp("_elem");
+ t_field felem(tset->get_elem_type(), elem);
+ local_vars << " " << declare_field(&felem, true) << endl;
+ generate_deserialize_field(out, is_xception, &felem, "", local_vars);
+ indent_impl(out) <<
+ prefix << ".Add(" << elem << ");" << endl;
+}
+
+void t_delphi_generator::generate_deserialize_list_element(ostream& out, bool is_xception, t_list* tlist, string prefix, ostream& local_vars) {
+ string elem = tmp("_elem");
+ t_field felem(tlist->get_elem_type(), elem);
+ local_vars << " " << declare_field(&felem, true) << endl;
+ generate_deserialize_field(out, is_xception, &felem, "", local_vars);
+ indent_impl(out) <<
+ prefix << ".Add(" << elem << ");" << endl;
+}
+
+void t_delphi_generator::generate_serialize_field(ostream& out, bool is_xception, t_field* tfield, string prefix, ostream& local_vars) {
+ t_type* type = tfield->get_type();
+ while (type->is_typedef()) {
+ type = ((t_typedef*)type)->get_type();
+ }
+
+ string name = prefix + prop_name(tfield, is_xception);
+
+ if (type->is_void()) {
+ throw "CANNOT GENERATE SERIALIZE CODE FOR void TYPE: " + name;
+ }
+
+ if (type->is_struct() || type->is_xception()) {
+ generate_serialize_struct(out, (t_struct*)type, name, local_vars);
+ } else if (type->is_container()) {
+ generate_serialize_container(out, is_xception, type, name, local_vars);
+ } else if (type->is_base_type() || type->is_enum()) {
+
+ indent_impl(out) <<
+ "oprot.";
+
+ if (type->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+
+ switch(tbase) {
+ case t_base_type::TYPE_VOID:
+ throw "compiler error: cannot serialize void field in a struct: " + name;
+ break;
+ case t_base_type::TYPE_STRING:
+ if (((t_base_type*)type)->is_binary()) {
+ if (ansistr_binary_) {
+ out << "WriteAnsiString(";
+ } else {
+ out << "WriteBinary(";
+ }
+ } else {
+ out << "WriteString(";
+ }
+ out << name << ");";
+ break;
+ case t_base_type::TYPE_BOOL:
+ out << "WriteBool(" << name << ");";
+ break;
+ case t_base_type::TYPE_BYTE:
+ out << "WriteByte(" << name << ");";
+ break;
+ case t_base_type::TYPE_I16:
+ out << "WriteI16(" << name << ");";
+ break;
+ case t_base_type::TYPE_I32:
+ out << "WriteI32(" << name << ");";
+ break;
+ case t_base_type::TYPE_I64:
+ out << "WriteI64(" << name << ");";
+ break;
+ case t_base_type::TYPE_DOUBLE:
+ out << "WriteDouble(" << name << ");";
+ break;
+ default:
+ throw "compiler error: no Delphi name for base type " + tbase;
+ }
+ } else if (type->is_enum()) {
+ out << "WriteI32(Integer(" << name << "));";
+ }
+ out << endl;
+ } else {
+ printf("DO NOT KNOW HOW TO SERIALIZE '%s%s' TYPE '%s'\n",
+ prefix.c_str(),
+ tfield->get_name().c_str(),
+ type_name(type).c_str());
+ }
+}
+
+void t_delphi_generator::generate_serialize_struct(ostream& out, t_struct* tstruct, string prefix, ostream& local_vars) {
+ (void) tstruct;
+ out <<
+ indent_impl() << prefix << ".Write(oprot);" << endl;
+}
+
+void t_delphi_generator::generate_serialize_container(ostream& out, bool is_xception, t_type* ttype, string prefix, ostream& local_vars) {
+ string obj;
+ if (ttype->is_map()) {
+ obj = tmp("map");
+ local_vars << " " << obj << " : IMap;" << endl;
+ indent_impl(out) << obj << " := TMapImpl.Create( " <<
+ type_to_enum(((t_map*)ttype)->get_key_type()) << ", " <<
+ type_to_enum(((t_map*)ttype)->get_val_type()) << ", " <<
+ prefix << ".Count);" << endl;
+ indent_impl(out) << "oprot.WriteMapBegin( " << obj << ");" << endl;
+ } else if (ttype->is_set()) {
+ obj = tmp("set_");
+ local_vars << " " << obj << " : ISet;" << endl;
+ indent_impl(out) << obj << " := TSetImpl.Create(" <<
+ type_to_enum(((t_set*)ttype)->get_elem_type()) << ", " <<
+ prefix << ".Count);" << endl;
+ indent_impl(out) <<
+ "oprot.WriteSetBegin( " << obj << ");" << endl;
+ } else if (ttype->is_list()) {
+ obj = tmp("list_");
+ local_vars << " " << obj << " : IList;" << endl;
+ indent_impl(out) << obj << " := TListImpl.Create(" <<
+ type_to_enum(((t_list*)ttype)->get_elem_type()) << ", " <<
+ prefix << ".Count);" << endl;
+ indent_impl(out) <<
+ "oprot.WriteListBegin( " << obj << ");" << endl;
+ }
+
+ string iter = tmp("_iter");
+ if (ttype->is_map()) {
+ local_vars << " " << iter << ": " << type_name(((t_map*)ttype)->get_key_type()) << ";" << endl;
+ indent_impl(out) << "for " << iter << " in " << prefix << ".Keys do" << endl;
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+ } else if (ttype->is_set()) {
+ local_vars << " " << iter << ": " << type_name(((t_set*)ttype)->get_elem_type()) << ";" << endl;
+ indent_impl(out) << "for " << iter << " in " << prefix << " do" << endl;
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+ } else if (ttype->is_list()) {
+ local_vars << " " << iter << ": " << type_name(((t_list*)ttype)->get_elem_type()) << ";" << endl;
+ indent_impl(out) << "for " << iter << " in " << prefix << " do" << endl;
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+ }
+
+ if (ttype->is_map()) {
+ generate_serialize_map_element(out, is_xception, (t_map*)ttype, iter, prefix, local_vars);
+ } else if (ttype->is_set()) {
+ generate_serialize_set_element(out, is_xception, (t_set*)ttype, iter, local_vars);
+ } else if (ttype->is_list()) {
+ generate_serialize_list_element(out, is_xception, (t_list*)ttype, iter, local_vars);
+ }
+
+ if (ttype->is_map()) {
+ indent_impl(out) << "oprot.WriteMapEnd();" << endl;
+ } else if (ttype->is_set()) {
+ indent_impl(out) << "oprot.WriteSetEnd();" << endl;
+ } else if (ttype->is_list()) {
+ indent_impl(out) << "oprot.WriteListEnd();" << endl;
+ }
+
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl;
+}
+
+void t_delphi_generator::generate_serialize_map_element(ostream& out, bool is_xception, t_map* tmap, string iter, string map, ostream& local_vars) {
+ t_field kfield(tmap->get_key_type(), iter);
+ generate_serialize_field(out, is_xception, &kfield, "", local_vars);
+ t_field vfield(tmap->get_val_type(), map + "[" + iter + "]");
+ generate_serialize_field(out, is_xception, &vfield, "", local_vars);
+}
+
+void t_delphi_generator::generate_serialize_set_element(ostream& out, bool is_xception, t_set* tset, string iter, ostream& local_vars) {
+ t_field efield(tset->get_elem_type(), iter);
+ generate_serialize_field(out, is_xception, &efield, "", local_vars);
+}
+
+void t_delphi_generator::generate_serialize_list_element(ostream& out, bool is_xception, t_list* tlist, string iter, ostream& local_vars) {
+ t_field efield(tlist->get_elem_type(), iter);
+ generate_serialize_field(out, is_xception, &efield, "", local_vars);
+}
+
+void t_delphi_generator::generate_property(ostream& out, t_field* tfield, bool isPublic, bool is_xception) {
+ generate_delphi_property(out, is_xception, tfield, isPublic, "Get");
+}
+
+void t_delphi_generator::generate_delphi_property(ostream& out, bool struct_is_xception, t_field* tfield, bool isPublic, std::string fieldPrefix) {
+ t_type* ftype = tfield->get_type();
+ bool is_xception = ftype->is_xception();
+ indent(out) << "property " << prop_name(tfield, struct_is_xception) << ": " << type_name(ftype, false, true, is_xception, true) << " read " << fieldPrefix + prop_name(tfield)
+ << " write Set" << prop_name(tfield) << ";" << endl;
+}
+
+std::string t_delphi_generator::prop_name(t_field* tfield, bool is_xception) {
+ return prop_name(tfield->get_name(), is_xception);
+}
+
+std::string t_delphi_generator::prop_name(string name, bool is_xception) {
+ string ret = name;
+ ret[0] = toupper(ret[0]);
+ return normalize_name( ret, true, is_xception);
+}
+
+string t_delphi_generator::normalize_clsnm(string clsnm, string prefix, bool b_no_check_keyword) {
+ if (clsnm.size() >= 0) {
+ clsnm[0] = toupper(clsnm[0]);
+ }
+ if (b_no_check_keyword) {
+ return prefix + clsnm;
+ } else {
+ return normalize_name( prefix + clsnm);
+ }
+}
+
+string t_delphi_generator::type_name( t_type* ttype, bool b_cls, bool b_no_postfix, bool b_exception_factory, bool b_full_exception_factory) {
+ while (ttype->is_typedef()) {
+ ttype = ((t_typedef*)ttype)->get_type();
+ }
+
+ string typ_nm;
+
+ string s_factory;
+
+ if (ttype->is_base_type()) {
+ return base_type_name((t_base_type*)ttype);
+ } else if (ttype->is_enum()) {
+ b_cls = true;
+ b_no_postfix = true;
+ } else if (ttype->is_map()) {
+ t_map *tmap = (t_map*) ttype;
+ if (b_cls) {
+ typ_nm = "TThriftDictionaryImpl";
+ } else {
+ typ_nm = "IThriftDictionary";
+ }
+ return typ_nm + "<" + type_name(tmap->get_key_type()) +
+ ", " + type_name(tmap->get_val_type()) + ">";
+ } else if (ttype->is_set()) {
+ t_set* tset = (t_set*) ttype;
+ if (b_cls) {
+ typ_nm = "THashSetImpl";
+ } else {
+ typ_nm = "IHashSet";
+ }
+ return typ_nm + "<" + type_name(tset->get_elem_type()) + ">";
+ } else if (ttype->is_list()) {
+ t_list* tlist = (t_list*) ttype;
+ if (b_cls) {
+ typ_nm = "TThriftListImpl";
+ } else {
+ typ_nm = "IThriftList";
+ }
+ return typ_nm + "<" + type_name(tlist->get_elem_type()) + ">";
+ }
+
+ string type_prefix;
+
+ if (b_cls) {
+ type_prefix = "T";
+ } else {
+ type_prefix = "I";
+ }
+
+ string nm = normalize_clsnm( ttype->get_name(), type_prefix);
+
+ if (b_exception_factory) {
+ nm = nm + "Factory";
+ }
+
+ if (b_cls) {
+ if (! b_no_postfix) {
+ nm = nm + "Impl";
+ }
+ }
+
+ if ( b_exception_factory && b_full_exception_factory) {
+ return type_name( ttype, true, true, false, false ) + "." + nm;
+ }
+
+ return nm;
+}
+
+string t_delphi_generator::base_type_name(t_base_type* tbase) {
+ switch (tbase->get_base()) {
+ case t_base_type::TYPE_VOID:
+ // no "void" in Delphi language
+ return "";
+ case t_base_type::TYPE_STRING:
+ if (tbase->is_binary()) {
+ if ( ansistr_binary_) {
+ return "AnsiString";
+ } else {
+ return "TBytes";
+ }
+ } else {
+ return "string";
+ }
+ case t_base_type::TYPE_BOOL:
+ return "Boolean";
+ case t_base_type::TYPE_BYTE:
+ return "ShortInt";
+ case t_base_type::TYPE_I16:
+ return "SmallInt";
+ case t_base_type::TYPE_I32:
+ return "Integer";
+ case t_base_type::TYPE_I64:
+ return "Int64";
+ case t_base_type::TYPE_DOUBLE:
+ return "Double";
+ default:
+ throw "compiler error: no Delphi name for base type " + tbase->get_base();
+ }
+}
+
+string t_delphi_generator::declare_field(t_field* tfield, bool init, std::string prefix) {
+ t_type * ftype = tfield->get_type();
+ bool is_xception = ftype->is_xception();
+
+ string result = prefix + prop_name(tfield) + ": " + type_name(ftype,false,true,is_xception,true) + ";";
+ return result;
+}
+
+string t_delphi_generator::function_signature(t_function* tfunction, std::string full_cls, bool is_xception) {
+ t_type* ttype = tfunction->get_returntype();
+ string prefix;
+ if (full_cls == "") {
+ prefix = "";
+ } else {
+ prefix = full_cls + ".";
+ }
+ if (is_void(ttype)) {
+ return "procedure " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "(" + argument_list(tfunction->get_arglist()) + ");";
+ } else {
+ return "function " + prefix + normalize_name(tfunction->get_name(), true, is_xception) + "(" + argument_list(tfunction->get_arglist()) + "): " + type_name(ttype, false, true, is_xception, true) + ";";
+ }
+}
+
+string t_delphi_generator::argument_list(t_struct* tstruct) {
+ string result = "";
+ const vector<t_field*>& fields = tstruct->get_members();
+ vector<t_field*>::const_iterator f_iter;
+ bool first = true;
+ t_type* tt;
+
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ if (first) {
+ first = false;
+ } else {
+ result += "; ";
+ }
+
+ tt = (*f_iter)->get_type();
+ result += normalize_name((*f_iter)->get_name()) + ": " + type_name( tt, false, true, tt->is_xception(), true);
+ }
+ return result;
+}
+
+string t_delphi_generator::type_to_enum(t_type* type) {
+ while (type->is_typedef()) {
+ type = ((t_typedef*)type)->get_type();
+ }
+
+ if (type->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+ switch (tbase) {
+ case t_base_type::TYPE_VOID:
+ throw "NO T_VOID CONSTRUCT";
+ case t_base_type::TYPE_STRING:
+ return "TType.String_";
+ case t_base_type::TYPE_BOOL:
+ return "TType.Bool_";
+ case t_base_type::TYPE_BYTE:
+ return "TType.Byte_";
+ case t_base_type::TYPE_I16:
+ return "TType.I16";
+ case t_base_type::TYPE_I32:
+ return "TType.I32";
+ case t_base_type::TYPE_I64:
+ return "TType.I64";
+ case t_base_type::TYPE_DOUBLE:
+ return "TType.Double_";
+ }
+ } else if (type->is_enum()) {
+ return "TType.I32";
+ } else if (type->is_struct() || type->is_xception()) {
+ return "TType.Struct";
+ } else if (type->is_map()) {
+ return "TType.Map";
+ } else if (type->is_set()) {
+ return "TType.Set_";
+ } else if (type->is_list()) {
+ return "TType.List";
+ }
+
+ throw "INVALID TYPE IN type_to_enum: " + type->get_name();
+}
+
+string t_delphi_generator::empty_value(t_type* type) {
+ while (type->is_typedef()) {
+ type = ((t_typedef*)type)->get_type();
+ }
+
+ if (type->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+ switch (tbase) {
+ case t_base_type::TYPE_VOID:
+ return "0";
+ case t_base_type::TYPE_STRING:
+ if (((t_base_type*)type)->is_binary()) {
+ if (ansistr_binary_) {
+ return "''";
+ } else {
+ return "nil";
+ }
+ } else {
+ return "''";
+ }
+ case t_base_type::TYPE_BOOL:
+ return "False";
+ case t_base_type::TYPE_BYTE:
+ case t_base_type::TYPE_I16:
+ case t_base_type::TYPE_I32:
+ case t_base_type::TYPE_I64:
+ return "0";
+ case t_base_type::TYPE_DOUBLE:
+ return "0.0";
+ }
+ } else if (type->is_enum()) {
+ return "T" + type->get_name() + "(0)";
+ } else if (type->is_struct() || type->is_xception()) {
+ return "nil";
+ } else if (type->is_map()) {
+ return "nil";
+ } else if (type->is_set()) {
+ return "nil";
+ } else if (type->is_list()) {
+ return "nil";
+ }
+
+ throw "INVALID TYPE IN type_to_enum: " + type->get_name();
+}
+
+void t_delphi_generator::generate_delphi_property_writer_definition(ostream& out, t_field* tfield) {
+ t_type * ftype = tfield->get_type();
+ bool is_xception = ftype->is_xception();
+
+ indent(out) << "procedure Set" << prop_name(tfield) << "( const Value: " << type_name(ftype,false,true,is_xception,true) << ");" << endl;
+}
+
+void t_delphi_generator::generate_delphi_property_reader_definition(ostream& out, t_field* tfield) {
+ t_type * ftype = tfield->get_type();
+ bool is_xception = ftype->is_xception();
+
+ indent(out) << "function Get" << prop_name(tfield) << ": " << type_name(ftype,false,true,is_xception,true) << ";" << endl;
+}
+
+void t_delphi_generator::generate_delphi_isset_reader_definition(ostream& out, t_field* tfield) {
+ indent(out) << "function Get__isset_" << prop_name( tfield) << ": Boolean;" << endl;
+}
+
+void t_delphi_generator::generate_delphi_property_writer_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix, bool is_xception_class, std::string xception_factroy_name) {
+ t_type * ftype = tfield->get_type();
+ bool is_xception = ftype->is_xception();
+
+ indent_impl(out) << "procedure " << cls_prefix << name << "." << "Set" << prop_name(tfield) << "( const Value: " << type_name(ftype,false,true,is_xception,true) << ");" << endl;
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(out) << "F__isset_" << prop_name(tfield) << " := True;" << endl;
+ indent_impl(out) << fieldPrefix << prop_name(tfield) << " := Value;" << endl;
+
+ if (is_xception_class) {
+ indent_impl(out) << "F" << xception_factroy_name << "." << prop_name(tfield) << " := Value;" << endl;
+ }
+
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl << endl;
+}
+
+void t_delphi_generator::generate_delphi_property_reader_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix) {
+ t_type * ftype = tfield->get_type();
+ bool is_xception = ftype->is_xception();
+
+ indent_impl(out) << "function " << cls_prefix << name << "." << "Get" << prop_name(tfield) << ": " << type_name(ftype,false,true,is_xception,true) << ";" << endl;
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(out) << "Result := " << fieldPrefix << prop_name(tfield) << ";" << endl;
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl << endl;
+}
+
+void t_delphi_generator::generate_delphi_isset_reader_impl(ostream& out, std::string cls_prefix, std::string name, t_type* type, t_field* tfield, std::string fieldPrefix) {
+ string isset_name = "__isset_" + prop_name( tfield);
+ indent_impl(out) << "function " << cls_prefix << name << "." << "Get" << isset_name << ": Boolean;" << endl;
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(out) << "Result := " << fieldPrefix << isset_name << ";" << endl;
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl << endl;
+}
+
+void t_delphi_generator::generate_delphi_create_exception_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) {
+ string exception_cls_nm = type_name(tstruct,true,true);
+ string cls_nm = type_name(tstruct,true,false,is_exception,is_exception);
+
+ indent_impl(out) << "function " << cls_nm << ".CreateException: " << exception_cls_nm << ";" << endl;
+
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+
+
+ indent_impl(out) << "Result := " << exception_cls_nm << ".Create;" << endl;
+ string factory_name = normalize_clsnm(tstruct->get_name(),"",true) + "Factory";
+ indent_impl(out) << "Result." << factory_name << " := Self;" << endl;
+
+ const vector<t_field*>& fields = tstruct->get_members();
+ vector<t_field*>::const_iterator f_iter;
+
+ string propname;
+
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ propname = prop_name(*f_iter);
+ indent_impl(out) << "if __isset_" << propname << " then" << endl;
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(out) << "Result." << propname << " := " << propname << ";" << endl;
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl;
+ }
+
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl << endl;
+}
+
+void t_delphi_generator::generate_delphi_struct_reader_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) {
+
+ ostringstream local_vars;
+ ostringstream code_block;
+
+ const vector<t_field*>& fields = tstruct->get_members();
+ vector<t_field*>::const_iterator f_iter;
+
+
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+
+ indent_impl(code_block) << "struc := iprot.ReadStructBegin;" << endl;
+
+ indent_impl(code_block) << "try" << endl;
+ indent_up_impl();
+
+ indent_impl(code_block) << "while (true) do" << endl;
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+
+ indent_impl(code_block) << "field_ := iprot.ReadFieldBegin();" << endl;
+
+ indent_impl(code_block) << "try" << endl;
+ indent_up_impl();
+
+ indent_impl(code_block) << "if (field_.Type_ = TType.Stop) then" << endl;
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(code_block) << "break;" << endl;
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl;
+
+
+ bool first = true;
+
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+
+ if (first) {
+ indent_impl(code_block) << "case field_.ID of" << endl;
+ indent_up_impl();
+ }
+
+ first = false;
+ if (f_iter != fields.begin()) {
+ code_block << ";" << endl;
+ }
+ indent_impl(code_block) << (*f_iter)->get_key() << ": begin" << endl;
+ indent_up_impl();
+ indent_impl(code_block) << "if (field_.Type_ = " << type_to_enum((*f_iter)->get_type()) << ") then" << endl;
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+
+ generate_deserialize_field(code_block, is_exception, *f_iter, "", local_vars);
+
+ indent_down_impl();
+
+ indent_impl(code_block) << "end else" << endl;
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(code_block) << "TProtocolUtil.Skip(iprot, field_.Type_);" << endl;
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl;
+ indent_down_impl();
+ indent_impl(code_block) << "end";
+
+ }
+
+ if (! first) {
+ code_block << endl;
+ indent_impl(code_block) << "else begin" << endl;
+ indent_up_impl();
+ }
+
+ indent_impl(code_block) << "TProtocolUtil.Skip(iprot, field_.Type_);" << endl;
+
+ if (! first) {
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl;
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl;
+ }
+
+
+ indent_down_impl();
+
+ indent_impl(code_block) << "finally" << endl;
+ indent_up_impl();
+ indent_impl(code_block) << "iprot.ReadFieldEnd;" << endl;
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl;
+
+ indent_down_impl();
+
+ indent_impl(code_block) << "end;" << endl;
+ indent_down_impl();
+
+ indent_impl(code_block) << "finally" << endl;
+ indent_up_impl();
+ indent_impl(code_block) << "iprot.ReadStructEnd;" << endl;
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl;
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl << endl;
+
+ string cls_nm;
+
+ cls_nm = type_name(tstruct,true,false,is_exception,is_exception);
+
+ indent_impl(out) << "procedure " << cls_prefix << cls_nm << ".Read( iprot: IProtocol);" << endl;
+ indent_impl(out) << "var" << endl;
+ indent_up_impl();
+ indent_impl(out) << "field_ : IField;" << endl;
+ indent_impl(out) << "struc : IStruct;" << endl;
+ indent_down_impl();
+ out << local_vars.str() << endl;
+ out << code_block.str();
+}
+
+void t_delphi_generator::generate_delphi_struct_result_writer_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) {
+
+ ostringstream local_vars;
+ ostringstream code_block;
+
+ string name = tstruct->get_name();
+ const vector<t_field*>& fields = tstruct->get_sorted_members();
+ vector<t_field*>::const_iterator f_iter;
+
+
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+
+ indent_impl(code_block) << "struc := TStructImpl.Create('" << name << "');" << endl;
+
+ indent_impl(code_block) << "oprot.WriteStructBegin(struc);" << endl;
+
+ if (fields.size() > 0) {
+ indent_impl(code_block) << "field_ := TFieldImpl.Create;" << endl;
+ bool first = true;
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ if (! first) {
+ indent_impl(code_block) << "end else" << endl;
+ }
+
+ indent_impl(code_block) << "if (__isset_" << prop_name(*f_iter) << ") then" << endl;
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+ indent_impl(code_block) <<
+ "field_.Name := '" << (*f_iter)->get_name() << "';" << endl;
+ indent_impl(code_block) <<
+ "field_.Type_ := " << type_to_enum((*f_iter)->get_type()) << ";" << endl;
+ indent_impl(code_block) <<
+ "field_.ID := " << (*f_iter)->get_key() << ";" << endl;
+ indent_impl(code_block) <<
+ "oprot.WriteFieldBegin(field_);" << endl;
+ generate_serialize_field(code_block, is_exception, *f_iter, "", local_vars);
+ indent_impl(code_block) << "oprot.WriteFieldEnd();" << endl;
+ indent_down_impl();
+ }
+
+ if (! first) {
+ indent_impl(code_block) << "end;" << endl;
+ }
+
+ }
+
+
+ indent_impl(code_block) << "oprot.WriteFieldStop();" << endl;
+ indent_impl(code_block) << "oprot.WriteStructEnd();" << endl;
+
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl << endl;
+
+ string cls_nm;
+
+ cls_nm = type_name(tstruct,true,false,is_exception,is_exception);
+
+ indent_impl(out) << "procedure " << cls_prefix << cls_nm << ".Write( oprot: IProtocol);" << endl;
+ indent_impl(out) << "var" << endl;
+ indent_up_impl();
+ indent_impl(out) << "struc : IStruct;" << endl;
+
+ if (fields.size() > 0) {
+ indent_impl(out) << "field_ : IField;" << endl;
+ }
+
+ out << local_vars.str();
+ indent_down_impl();
+ out << code_block.str();
+
+}
+
+void t_delphi_generator::generate_delphi_struct_writer_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) {
+
+ ostringstream local_vars;
+ ostringstream code_block;
+
+ string name = tstruct->get_name();
+ const vector<t_field*>& fields = tstruct->get_sorted_members();
+ vector<t_field*>::const_iterator f_iter;
+
+
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+
+ indent_impl(code_block) << "struc := TStructImpl.Create('" << name << "');" << endl;
+
+ indent_impl(code_block) << "oprot.WriteStructBegin(struc);" << endl;
+
+ if (fields.size() > 0) {
+ indent_impl(code_block) << "field_ := TFieldImpl.Create;" << endl;
+ }
+
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ bool null_allowed = type_can_be_null((*f_iter)->get_type());
+ if (null_allowed) {
+ indent_impl(code_block) <<
+ "if ((" << prop_name((*f_iter)) << " <> nil) and __isset_" << prop_name(*f_iter) << ") then" << endl;
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+ } else {
+ indent_impl(code_block) << "if (__isset_" << prop_name(*f_iter) << ") then" << endl;
+ indent_impl(code_block) << "begin" << endl;
+ indent_up_impl();
+ }
+ indent_impl(code_block) <<
+ "field_.Name := '" << (*f_iter)->get_name() << "';" << endl;
+ indent_impl(code_block) <<
+ "field_.Type_ := " << type_to_enum((*f_iter)->get_type()) << ";" << endl;
+ indent_impl(code_block) <<
+ "field_.ID := " << (*f_iter)->get_key() << ";" << endl;
+ indent_impl(code_block) <<
+ "oprot.WriteFieldBegin(field_);" << endl;
+ generate_serialize_field(code_block, is_exception, *f_iter, "", local_vars);
+ indent_impl(code_block) << "oprot.WriteFieldEnd();" << endl;
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl;
+ }
+
+ indent_impl(code_block) << "oprot.WriteFieldStop();" << endl;
+ indent_impl(code_block) << "oprot.WriteStructEnd();" << endl;
+
+ indent_down_impl();
+ indent_impl(code_block) << "end;" << endl << endl;
+
+ string cls_nm;
+
+ cls_nm = type_name(tstruct,true,false,is_exception,is_exception);
+
+ indent_impl(out) << "procedure " << cls_prefix << cls_nm << ".Write( oprot: IProtocol);" << endl;
+ indent_impl(out) << "var" << endl;
+ indent_up_impl();
+ indent_impl(out) << "struc : IStruct;" << endl;
+ if (fields.size() > 0) {
+ indent_impl(out) << "field_ : IField;" << endl;
+ }
+ out << local_vars.str();
+ indent_down_impl();
+ out << code_block.str();
+
+}
+
+void t_delphi_generator::generate_delphi_struct_tostring_impl(ostream& out, string cls_prefix, t_struct* tstruct, bool is_exception) {
+
+ const vector<t_field*>& fields = tstruct->get_members();
+ vector<t_field*>::const_iterator f_iter;
+
+ string cls_nm;
+
+ if (is_exception) {
+ cls_nm = type_name(tstruct,true,false,true,true);
+ } else {
+ cls_nm = type_name(tstruct,true,false);
+ }
+
+ string tmp_sb = "sb";
+
+ indent_impl(out) << "function " << cls_prefix << cls_nm << ".ToString: string;" << endl;
+ indent_impl(out) << "var" << endl;
+ indent_up_impl();
+ indent_impl(out) << tmp_sb << " : TThriftStringBuilder;" << endl;
+ indent_down_impl();
+ indent_impl(out) << "begin" << endl;
+ indent_up_impl();
+
+ indent_impl(out) << tmp_sb << " := TThriftStringBuilder.Create('(');" << endl;
+ indent_impl(out) << "try" << endl;
+ indent_up_impl();
+
+ bool first = true;
+
+ for (f_iter = fields.begin(); f_iter != fields.end(); ++f_iter) {
+ if (first) {
+ first = false;
+ indent_impl(out) <<
+ tmp_sb << ".Append('" << prop_name((*f_iter)) << ": ');" << endl;
+ } else {
+ indent_impl(out) <<
+ tmp_sb << ".Append('," << prop_name((*f_iter)) << ": ');" << endl;
+ }
+ t_type* ttype = (*f_iter)->get_type();
+ if (ttype->is_xception() || ttype->is_struct()) {
+ indent_impl(out) <<
+ "if (" << prop_name((*f_iter)) << " = nil) then " << tmp_sb << ".Append('<null>') else " << tmp_sb << ".Append("<< prop_name((*f_iter)) << ".ToString());" << endl;
+ } else if (ttype->is_enum()) {
+ indent_impl(out) <<
+ tmp_sb << ".Append(Integer(" << prop_name((*f_iter)) << "));" << endl;
+ } else {
+ indent_impl(out) <<
+ tmp_sb << ".Append(" << prop_name((*f_iter)) << ");" << endl;
+ }
+ }
+
+ indent_impl(out) <<
+ tmp_sb << ".Append(')');" << endl;
+ indent_impl(out) <<
+ "Result := " << tmp_sb << ".ToString;" << endl;
+
+ indent_down_impl();
+ indent_impl(out) << "finally" << endl;
+ indent_up_impl();
+ indent_impl(out) << tmp_sb << ".Free;" << endl;
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl;
+
+ indent_down_impl();
+ indent_impl(out) << "end;" << endl << endl;
+}
+
+bool t_delphi_generator::is_void( t_type* type ) {
+ while (type->is_typedef()) {
+ type = ((t_typedef*)type)->get_type();
+ }
+
+ if (type->is_base_type()) {
+ t_base_type::t_base tbase = ((t_base_type*)type)->get_base();
+ if (tbase == t_base_type::TYPE_VOID) {
+ return true;
+ }
+ }
+ return false;
+}
+
+THRIFT_REGISTER_GENERATOR(delphi, "delphi",
+" ansistr_binary: Use AnsiString as binary properties.\n" \
+" suppress_guid: Suppress GUID for interface declaretion.\n")
+
bool gen_hs = false;
bool gen_cocoa = false;
bool gen_csharp = false;
+bool gen_delphi = false;
bool gen_st = false;
bool gen_recurse = false;
gen_st = true;
} else if (strcmp(arg, "-csharp") == 0) {
gen_csharp = true;
+ } else if (strcmp(arg, "-delphi") == 0) {
+ gen_delphi = true;
} else if (strcmp(arg, "-cpp_use_include_prefix") == 0) {
g_cpp_use_include_prefix = true;
} else if (strcmp(arg, "-I") == 0) {
pwarning(1, "-csharp is deprecated. Use --gen csharp");
generator_strings.push_back("csharp");
}
+ if (gen_delphi) {
+ pwarning(1, "-delphi is deprecated. Use --gen delphi");
+ generator_strings.push_back("delphi");
+ }
if (gen_py) {
pwarning(1, "-py is deprecated. Use --gen py");
generator_strings.push_back("py");
"java_package" { return tok_java_package; }
"cocoa_prefix" { return tok_cocoa_prefix; }
"csharp_namespace" { return tok_csharp_namespace; }
+"delphi_namespace" { return tok_delphi_namespace; }
"php_namespace" { return tok_php_namespace; }
"py_module" { return tok_py_module; }
"perl_package" { return tok_perl_package; }
%token tok_smalltalk_prefix
%token tok_cocoa_prefix
%token tok_csharp_namespace
+%token tok_delphi_namespace
/**
* Base datatype keywords
g_program->set_namespace("csharp", $2);
}
}
+/* TODO(dreiss): Get rid of this once everyone is using the new hotness. */
+| tok_delphi_namespace tok_identifier
+ {
+ pwarning(1, "'delphi_namespace' is deprecated. Use 'namespace delphi' instead");
+ pdebug("Header -> tok_delphi_namespace tok_identifier");
+ if (g_parse_mode == PROGRAM) {
+ g_program->set_namespace("delphi", $2);
+ }
+ }
Include:
tok_include tok_literal
if test "$have_ruby" = "yes" ; then
echo
echo "Using Ruby ................... : $RUBY"
- echo "Using rspec .................. : $RSPEC"
fi
if test "$have_haskell" = "yes" ; then
echo
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+unit Thrift.Collections;\r
+\r
+interface\r
+\r
+uses\r
+ Generics.Collections, Generics.Defaults, Thrift.Utils;\r
+\r
+type\r
+\r
+{$IF CompilerVersion < 21.0}\r
+ TArray<T> = array of T;\r
+{$IFEND}\r
+\r
+ IThriftContainer = interface\r
+ ['{93DEF5A0-D162-461A-AB22-5B4EE0734050}']\r
+ function ToString: string;\r
+ end;\r
+\r
+ IThriftDictionary<TKey,TValue> = interface(IThriftContainer)\r
+ ['{25EDD506-F9D1-4008-A40F-5940364B7E46}']\r
+ function GetEnumerator: TEnumerator<TPair<TKey,TValue>>;\r
+\r
+ function GetKeys: TDictionary<TKey,TValue>.TKeyCollection;\r
+ function GetValues: TDictionary<TKey,TValue>.TValueCollection;\r
+ function GetItem(const Key: TKey): TValue;\r
+ procedure SetItem(const Key: TKey; const Value: TValue);\r
+ function GetCount: Integer;\r
+\r
+ procedure Add(const Key: TKey; const Value: TValue);\r
+ procedure Remove(const Key: TKey);\r
+{$IF CompilerVersion >= 21.0}\r
+ function ExtractPair(const Key: TKey): TPair<TKey,TValue>;\r
+{$IFEND}\r
+ procedure Clear;\r
+ procedure TrimExcess;\r
+ function TryGetValue(const Key: TKey; out Value: TValue): Boolean;\r
+ procedure AddOrSetValue(const Key: TKey; const Value: TValue);\r
+ function ContainsKey(const Key: TKey): Boolean;\r
+ function ContainsValue(const Value: TValue): Boolean;\r
+ function ToArray: TArray<TPair<TKey,TValue>>;\r
+\r
+ property Items[const Key: TKey]: TValue read GetItem write SetItem; default;\r
+ property Count: Integer read GetCount;\r
+ property Keys: TDictionary<TKey,TValue>.TKeyCollection read GetKeys;\r
+ property Values: TDictionary<TKey,TValue>.TValueCollection read GetValues;\r
+ end;\r
+\r
+ TThriftDictionaryImpl<TKey,TValue> = class( TInterfacedObject, IThriftDictionary<TKey,TValue>)\r
+ private\r
+ FDictionaly : TDictionary<TKey,TValue>;\r
+ protected\r
+ function GetEnumerator: TEnumerator<TPair<TKey,TValue>>;\r
+\r
+ function GetKeys: TDictionary<TKey,TValue>.TKeyCollection;\r
+ function GetValues: TDictionary<TKey,TValue>.TValueCollection;\r
+ function GetItem(const Key: TKey): TValue;\r
+ procedure SetItem(const Key: TKey; const Value: TValue);\r
+ function GetCount: Integer;\r
+\r
+ procedure Add(const Key: TKey; const Value: TValue);\r
+ procedure Remove(const Key: TKey);\r
+{$IF CompilerVersion >= 21.0}\r
+ function ExtractPair(const Key: TKey): TPair<TKey,TValue>;\r
+{$IFEND}\r
+ procedure Clear;\r
+ procedure TrimExcess;\r
+ function TryGetValue(const Key: TKey; out Value: TValue): Boolean;\r
+ procedure AddOrSetValue(const Key: TKey; const Value: TValue);\r
+ function ContainsKey(const Key: TKey): Boolean;\r
+ function ContainsValue(const Value: TValue): Boolean;\r
+ function ToArray: TArray<TPair<TKey,TValue>>;\r
+ property Items[const Key: TKey]: TValue read GetItem write SetItem; default;\r
+ property Count: Integer read GetCount;\r
+ property Keys: TDictionary<TKey,TValue>.TKeyCollection read GetKeys;\r
+ property Values: TDictionary<TKey,TValue>.TValueCollection read GetValues;\r
+ public\r
+ constructor Create(ACapacity: Integer = 0);\r
+ destructor Destroy; override;\r
+ end;\r
+\r
+ IThriftList<T> = interface(IThriftContainer)\r
+ ['{29BEEE31-9CB4-401B-AA04-5148A75F473B}']\r
+ function GetEnumerator: TEnumerator<T>;\r
+ function GetCapacity: Integer;\r
+ procedure SetCapacity(Value: Integer);\r
+ function GetCount: Integer;\r
+ procedure SetCount(Value: Integer);\r
+ function GetItem(Index: Integer): T;\r
+ procedure SetItem(Index: Integer; const Value: T);\r
+ function Add(const Value: T): Integer;\r
+ procedure AddRange(const Values: array of T); overload;\r
+ procedure AddRange(const Collection: IEnumerable<T>); overload;\r
+ procedure AddRange(Collection: TEnumerable<T>); overload;\r
+ procedure Insert(Index: Integer; const Value: T);\r
+ procedure InsertRange(Index: Integer; const Values: array of T); overload;\r
+ procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;\r
+ procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;\r
+ function Remove(const Value: T): Integer;\r
+ procedure Delete(Index: Integer);\r
+ procedure DeleteRange(AIndex, ACount: Integer);\r
+ function Extract(const Value: T): T;\r
+{$IF CompilerVersion >= 21.0}\r
+ procedure Exchange(Index1, Index2: Integer);\r
+ procedure Move(CurIndex, NewIndex: Integer);\r
+ function First: T;\r
+ function Last: T;\r
+{$IFEND}\r
+ procedure Clear;\r
+ function Contains(const Value: T): Boolean;\r
+ function IndexOf(const Value: T): Integer;\r
+ function LastIndexOf(const Value: T): Integer;\r
+ procedure Reverse;\r
+ procedure Sort; overload;\r
+ procedure Sort(const AComparer: IComparer<T>); overload;\r
+ function BinarySearch(const Item: T; out Index: Integer): Boolean; overload;\r
+ function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload;\r
+ procedure TrimExcess;\r
+ function ToArray: TArray<T>;\r
+ property Capacity: Integer read GetCapacity write SetCapacity;\r
+ property Count: Integer read GetCount write SetCount;\r
+ property Items[Index: Integer]: T read GetItem write SetItem; default;\r
+ end;\r
+\r
+ TThriftListImpl<T> = class( TInterfacedObject, IThriftList<T>)\r
+ private\r
+ FList : TList<T>;\r
+ protected\r
+ function GetEnumerator: TEnumerator<T>;\r
+ function GetCapacity: Integer;\r
+ procedure SetCapacity(Value: Integer);\r
+ function GetCount: Integer;\r
+ procedure SetCount(Value: Integer);\r
+ function GetItem(Index: Integer): T;\r
+ procedure SetItem(Index: Integer; const Value: T);\r
+ function Add(const Value: T): Integer;\r
+ procedure AddRange(const Values: array of T); overload;\r
+ procedure AddRange(const Collection: IEnumerable<T>); overload;\r
+ procedure AddRange(Collection: TEnumerable<T>); overload;\r
+ procedure Insert(Index: Integer; const Value: T);\r
+ procedure InsertRange(Index: Integer; const Values: array of T); overload;\r
+ procedure InsertRange(Index: Integer; const Collection: IEnumerable<T>); overload;\r
+ procedure InsertRange(Index: Integer; const Collection: TEnumerable<T>); overload;\r
+ function Remove(const Value: T): Integer;\r
+ procedure Delete(Index: Integer);\r
+ procedure DeleteRange(AIndex, ACount: Integer);\r
+ function Extract(const Value: T): T;\r
+{$IF CompilerVersion >= 21.0}\r
+ procedure Exchange(Index1, Index2: Integer);\r
+ procedure Move(CurIndex, NewIndex: Integer);\r
+ function First: T;\r
+ function Last: T;\r
+{$IFEND}\r
+ procedure Clear;\r
+ function Contains(const Value: T): Boolean;\r
+ function IndexOf(const Value: T): Integer;\r
+ function LastIndexOf(const Value: T): Integer;\r
+ procedure Reverse;\r
+ procedure Sort; overload;\r
+ procedure Sort(const AComparer: IComparer<T>); overload;\r
+ function BinarySearch(const Item: T; out Index: Integer): Boolean; overload;\r
+ function BinarySearch(const Item: T; out Index: Integer; const AComparer: IComparer<T>): Boolean; overload;\r
+ procedure TrimExcess;\r
+ function ToArray: TArray<T>;\r
+ property Capacity: Integer read GetCapacity write SetCapacity;\r
+ property Count: Integer read GetCount write SetCount;\r
+ property Items[Index: Integer]: T read GetItem write SetItem; default;\r
+ public\r
+ constructor Create;\r
+ destructor Destroy; override;\r
+ end;\r
+\r
+ IHashSet<TValue> = interface(IThriftContainer)\r
+ ['{0923A3B5-D4D4-48A8-91AD-40238E2EAD66}']\r
+ function GetEnumerator: TEnumerator<TValue>;\r
+ function GetIsReadOnly: Boolean;\r
+ function GetCount: Integer;\r
+ property Count: Integer read GetCount;\r
+ property IsReadOnly: Boolean read GetIsReadOnly;\r
+ procedure Add( item: TValue);\r
+ procedure Clear;\r
+ function Contains( item: TValue): Boolean;\r
+ procedure CopyTo(var A: TArray<TValue>; arrayIndex: Integer);\r
+ function Remove( item: TValue ): Boolean;\r
+ end;\r
+\r
+ THashSetImpl<TValue> = class( TInterfacedObject, IHashSet<TValue>)\r
+ private\r
+ FDictionary : IThriftDictionary<TValue,Integer>;\r
+ FIsReadOnly: Boolean;\r
+ protected\r
+ function GetEnumerator: TEnumerator<TValue>;\r
+ function GetIsReadOnly: Boolean;\r
+ function GetCount: Integer;\r
+ property Count: Integer read GetCount;\r
+ property IsReadOnly: Boolean read FIsReadOnly;\r
+ procedure Add( item: TValue);\r
+ procedure Clear;\r
+ function Contains( item: TValue): Boolean;\r
+ procedure CopyTo(var A: TArray<TValue>; arrayIndex: Integer);\r
+ function Remove( item: TValue ): Boolean;\r
+ public\r
+ constructor Create;\r
+ end;\r
+\r
+implementation\r
+\r
+{ THashSetImpl<TValue> }\r
+\r
+procedure THashSetImpl<TValue>.Add(item: TValue);\r
+begin\r
+ if not FDictionary.ContainsKey(item) then\r
+ begin\r
+ FDictionary.Add( item, 0);\r
+ end;\r
+end;\r
+\r
+procedure THashSetImpl<TValue>.Clear;\r
+begin\r
+ FDictionary.Clear;\r
+end;\r
+\r
+function THashSetImpl<TValue>.Contains(item: TValue): Boolean;\r
+begin\r
+ Result := FDictionary.ContainsKey(item);\r
+end;\r
+\r
+procedure THashSetImpl<TValue>.CopyTo(var A: TArray<TValue>; arrayIndex: Integer);\r
+var\r
+ i : Integer;\r
+ Enumlator : TEnumerator<TValue>;\r
+begin\r
+ Enumlator := GetEnumerator;\r
+ while Enumlator.MoveNext do\r
+ begin\r
+ A[arrayIndex] := Enumlator.Current;\r
+ Inc(arrayIndex);\r
+ end;\r
+end;\r
+\r
+constructor THashSetImpl<TValue>.Create;\r
+begin\r
+ inherited;\r
+ FDictionary := TThriftDictionaryImpl<TValue,Integer>.Create;\r
+end;\r
+\r
+function THashSetImpl<TValue>.GetCount: Integer;\r
+begin\r
+ Result := FDictionary.Count;\r
+end;\r
+\r
+function THashSetImpl<TValue>.GetEnumerator: TEnumerator<TValue>;\r
+begin\r
+ Result := FDictionary.Keys.GetEnumerator;\r
+end;\r
+\r
+function THashSetImpl<TValue>.GetIsReadOnly: Boolean;\r
+begin\r
+ Result := FIsReadOnly;\r
+end;\r
+\r
+function THashSetImpl<TValue>.Remove(item: TValue): Boolean;\r
+begin\r
+ Result := False;\r
+ if FDictionary.ContainsKey( item ) then\r
+ begin\r
+ FDictionary.Remove( item );\r
+ Result := not FDictionary.ContainsKey( item );\r
+ end;\r
+end;\r
+\r
+{ TThriftDictionaryImpl<TKey, TValue> }\r
+\r
+procedure TThriftDictionaryImpl<TKey, TValue>.Add(const Key: TKey;\r
+ const Value: TValue);\r
+begin\r
+ FDictionaly.Add( Key, Value);\r
+end;\r
+\r
+procedure TThriftDictionaryImpl<TKey, TValue>.AddOrSetValue(const Key: TKey;\r
+ const Value: TValue);\r
+begin\r
+ FDictionaly.AddOrSetValue( Key, Value);\r
+end;\r
+\r
+procedure TThriftDictionaryImpl<TKey, TValue>.Clear;\r
+begin\r
+ FDictionaly.Clear;\r
+end;\r
+\r
+function TThriftDictionaryImpl<TKey, TValue>.ContainsKey(\r
+ const Key: TKey): Boolean;\r
+begin\r
+ Result := FDictionaly.ContainsKey( Key );\r
+end;\r
+\r
+function TThriftDictionaryImpl<TKey, TValue>.ContainsValue(\r
+ const Value: TValue): Boolean;\r
+begin\r
+ Result := FDictionaly.ContainsValue( Value );\r
+end;\r
+\r
+constructor TThriftDictionaryImpl<TKey, TValue>.Create(ACapacity: Integer);\r
+begin\r
+ FDictionaly := TDictionary<TKey,TValue>.Create( ACapacity );\r
+end;\r
+\r
+destructor TThriftDictionaryImpl<TKey, TValue>.Destroy;\r
+begin\r
+ FDictionaly.Free;\r
+ inherited;\r
+end;\r
+\r
+{$IF CompilerVersion >= 21.0}\r
+function TThriftDictionaryImpl<TKey, TValue>.ExtractPair(\r
+ const Key: TKey): TPair<TKey, TValue>;\r
+begin\r
+ Result := FDictionaly.ExtractPair( Key);\r
+end;\r
+{$IFEND}\r
+\r
+function TThriftDictionaryImpl<TKey, TValue>.GetCount: Integer;\r
+begin\r
+ Result := FDictionaly.Count;\r
+end;\r
+\r
+function TThriftDictionaryImpl<TKey, TValue>.GetEnumerator: TEnumerator<TPair<TKey, TValue>>;\r
+begin\r
+ Result := FDictionaly.GetEnumerator;\r
+end;\r
+\r
+function TThriftDictionaryImpl<TKey, TValue>.GetItem(const Key: TKey): TValue;\r
+begin\r
+ Result := FDictionaly.Items[Key];\r
+end;\r
+\r
+function TThriftDictionaryImpl<TKey, TValue>.GetKeys: TDictionary<TKey, TValue>.TKeyCollection;\r
+begin\r
+ Result := FDictionaly.Keys;\r
+end;\r
+\r
+function TThriftDictionaryImpl<TKey, TValue>.GetValues: TDictionary<TKey, TValue>.TValueCollection;\r
+begin\r
+ Result := FDictionaly.Values;\r
+end;\r
+\r
+procedure TThriftDictionaryImpl<TKey, TValue>.Remove(const Key: TKey);\r
+begin\r
+ FDictionaly.Remove( Key );\r
+end;\r
+\r
+procedure TThriftDictionaryImpl<TKey, TValue>.SetItem(const Key: TKey;\r
+ const Value: TValue);\r
+begin\r
+ FDictionaly.AddOrSetValue( Key, Value);\r
+end;\r
+\r
+function TThriftDictionaryImpl<TKey, TValue>.ToArray: TArray<TPair<TKey, TValue>>;\r
+{$IF CompilerVersion < 22.0}\r
+var\r
+ x : TPair<TKey, TValue>;\r
+ i : Integer;\r
+{$IFEND}\r
+begin\r
+{$IF CompilerVersion < 22.0}\r
+ SetLength(Result, Count);\r
+ i := 0;\r
+ for x in FDictionaly do\r
+ begin\r
+ Result[i] := x;\r
+ Inc( i );\r
+ end;\r
+{$ELSE}\r
+ Result := FDictionaly.ToArray;\r
+{$IFEND}\r
+end;\r
+\r
+procedure TThriftDictionaryImpl<TKey, TValue>.TrimExcess;\r
+begin\r
+ FDictionaly.TrimExcess;\r
+end;\r
+\r
+function TThriftDictionaryImpl<TKey, TValue>.TryGetValue(const Key: TKey;\r
+ out Value: TValue): Boolean;\r
+begin\r
+ Result := FDictionaly.TryGetValue( Key, Value);\r
+end;\r
+\r
+{ TThriftListImpl<T> }\r
+\r
+function TThriftListImpl<T>.Add(const Value: T): Integer;\r
+begin\r
+ Result := FList.Add( Value );\r
+end;\r
+\r
+procedure TThriftListImpl<T>.AddRange(Collection: TEnumerable<T>);\r
+begin\r
+ FList.AddRange( Collection );\r
+end;\r
+\r
+procedure TThriftListImpl<T>.AddRange(const Collection: IEnumerable<T>);\r
+begin\r
+ FList.AddRange( Collection );\r
+end;\r
+\r
+procedure TThriftListImpl<T>.AddRange(const Values: array of T);\r
+begin\r
+ FList.AddRange( Values );\r
+end;\r
+\r
+function TThriftListImpl<T>.BinarySearch(const Item: T;\r
+ out Index: Integer): Boolean;\r
+begin\r
+ Result := FList.BinarySearch( Item, Index);\r
+end;\r
+\r
+function TThriftListImpl<T>.BinarySearch(const Item: T; out Index: Integer;\r
+ const AComparer: IComparer<T>): Boolean;\r
+begin\r
+ Result := FList.BinarySearch( Item, Index, AComparer);\r
+end;\r
+\r
+procedure TThriftListImpl<T>.Clear;\r
+begin\r
+ FList.Clear;\r
+end;\r
+\r
+function TThriftListImpl<T>.Contains(const Value: T): Boolean;\r
+begin\r
+ Result := FList.Contains( Value );\r
+end;\r
+\r
+constructor TThriftListImpl<T>.Create;\r
+begin\r
+ FList := TList<T>.Create;\r
+end;\r
+\r
+procedure TThriftListImpl<T>.Delete(Index: Integer);\r
+begin\r
+ FList.Delete( Index )\r
+end;\r
+\r
+procedure TThriftListImpl<T>.DeleteRange(AIndex, ACount: Integer);\r
+begin\r
+ FList.DeleteRange( AIndex, ACount)\r
+end;\r
+\r
+destructor TThriftListImpl<T>.Destroy;\r
+begin\r
+ FList.Free;\r
+ inherited;\r
+end;\r
+\r
+{$IF CompilerVersion >= 21.0}\r
+procedure TThriftListImpl<T>.Exchange(Index1, Index2: Integer);\r
+begin\r
+ FList.Exchange( Index1, Index2 )\r
+end;\r
+{$IFEND}\r
+\r
+function TThriftListImpl<T>.Extract(const Value: T): T;\r
+begin\r
+ Result := FList.Extract( Value )\r
+end;\r
+\r
+{$IF CompilerVersion >= 21.0}\r
+function TThriftListImpl<T>.First: T;\r
+begin\r
+ Result := FList.First;\r
+end;\r
+{$IFEND}\r
+\r
+function TThriftListImpl<T>.GetCapacity: Integer;\r
+begin\r
+ Result := FList.Capacity;\r
+end;\r
+\r
+function TThriftListImpl<T>.GetCount: Integer;\r
+begin\r
+ Result := FList.Count;\r
+end;\r
+\r
+function TThriftListImpl<T>.GetEnumerator: TEnumerator<T>;\r
+begin\r
+ Result := FList.GetEnumerator;\r
+end;\r
+\r
+function TThriftListImpl<T>.GetItem(Index: Integer): T;\r
+begin\r
+ Result := FList[Index];\r
+end;\r
+\r
+function TThriftListImpl<T>.IndexOf(const Value: T): Integer;\r
+begin\r
+ Result := FList.IndexOf( Value );\r
+end;\r
+\r
+procedure TThriftListImpl<T>.Insert(Index: Integer; const Value: T);\r
+begin\r
+ FList.Insert( Index, Value);\r
+end;\r
+\r
+procedure TThriftListImpl<T>.InsertRange(Index: Integer;\r
+ const Collection: TEnumerable<T>);\r
+begin\r
+ FList.InsertRange( Index, Collection );\r
+end;\r
+\r
+procedure TThriftListImpl<T>.InsertRange(Index: Integer;\r
+ const Values: array of T);\r
+begin\r
+ FList.InsertRange( Index, Values);\r
+end;\r
+\r
+procedure TThriftListImpl<T>.InsertRange(Index: Integer;\r
+ const Collection: IEnumerable<T>);\r
+begin\r
+ FList.InsertRange( Index, Collection );\r
+end;\r
+\r
+{$IF CompilerVersion >= 21.0}\r
+function TThriftListImpl<T>.Last: T;\r
+begin\r
+ Result := FList.Last;\r
+end;\r
+{$IFEND}\r
+\r
+function TThriftListImpl<T>.LastIndexOf(const Value: T): Integer;\r
+begin\r
+ Result := FList.LastIndexOf( Value );\r
+end;\r
+\r
+{$IF CompilerVersion >= 21.0}\r
+procedure TThriftListImpl<T>.Move(CurIndex, NewIndex: Integer);\r
+begin\r
+ FList.Move( CurIndex, NewIndex);\r
+end;\r
+{$IFEND}\r
+\r
+function TThriftListImpl<T>.Remove(const Value: T): Integer;\r
+begin\r
+ Result := FList.Remove( Value );\r
+end;\r
+\r
+procedure TThriftListImpl<T>.Reverse;\r
+begin\r
+ FList.Reverse;\r
+end;\r
+\r
+procedure TThriftListImpl<T>.SetCapacity(Value: Integer);\r
+begin\r
+ FList.Capacity := Value;\r
+end;\r
+\r
+procedure TThriftListImpl<T>.SetCount(Value: Integer);\r
+begin\r
+ FList.Count := Value;\r
+end;\r
+\r
+procedure TThriftListImpl<T>.SetItem(Index: Integer; const Value: T);\r
+begin\r
+ FList[Index] := Value;\r
+end;\r
+\r
+procedure TThriftListImpl<T>.Sort;\r
+begin\r
+ FList.Sort;\r
+end;\r
+\r
+procedure TThriftListImpl<T>.Sort(const AComparer: IComparer<T>);\r
+begin\r
+ FList.Sort;\r
+end;\r
+\r
+function TThriftListImpl<T>.ToArray: TArray<T>;\r
+{$IF CompilerVersion < 22.0}\r
+var\r
+ x : T;\r
+ i : Integer;\r
+{$IFEND}\r
+begin\r
+{$IF CompilerVersion < 22.0}\r
+ SetLength(Result, Count);\r
+ i := 0;\r
+ for x in FList do\r
+ begin\r
+ Result[i] := x;\r
+ Inc( i );\r
+ end;\r
+{$ELSE}\r
+ Result := FList.ToArray;\r
+{$IFEND}\r
+end;\r
+\r
+procedure TThriftListImpl<T>.TrimExcess;\r
+begin\r
+ FList.TrimExcess;\r
+end;\r
+\r
+end.\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+unit Thrift.Console;\r
+\r
+interface\r
+\r
+uses\r
+ StdCtrls;\r
+\r
+type\r
+ TThriftConsole = class\r
+ public\r
+ procedure Write( const S: string); virtual;\r
+ procedure WriteLine( const S: string); virtual;\r
+ end;\r
+\r
+ TGUIConsole = class( TThriftConsole )\r
+ private\r
+ FLineBreak : Boolean;\r
+ FMemo : TMemo;\r
+\r
+ procedure InternalWrite( const S: string; bWriteLine: Boolean);\r
+ public\r
+ procedure Write( const S: string); override;\r
+ procedure WriteLine( const S: string); override;\r
+ constructor Create( AMemo: TMemo);\r
+ end;\r
+\r
+function Console: TThriftConsole;\r
+procedure ChangeConsole( AConsole: TThriftConsole );\r
+procedure RestoreConsoleToDefault;\r
+\r
+implementation\r
+\r
+var\r
+ FDefaultConsole : TThriftConsole;\r
+ FConsole : TThriftConsole;\r
+\r
+function Console: TThriftConsole;\r
+begin\r
+ Result := FConsole;\r
+end;\r
+\r
+{ TThriftConsole }\r
+\r
+procedure TThriftConsole.Write(const S: string);\r
+begin\r
+ System.Write( S );\r
+end;\r
+\r
+procedure TThriftConsole.WriteLine(const S: string);\r
+begin\r
+ System.Writeln( S );\r
+end;\r
+\r
+procedure ChangeConsole( AConsole: TThriftConsole );\r
+begin\r
+ FConsole := AConsole;\r
+end;\r
+\r
+procedure RestoreConsoleToDefault;\r
+begin\r
+ FConsole := FDefaultConsole;\r
+end;\r
+\r
+{ TGUIConsole }\r
+\r
+constructor TGUIConsole.Create( AMemo: TMemo);\r
+begin\r
+ FMemo := AMemo;\r
+ FLineBreak := True;\r
+end;\r
+\r
+procedure TGUIConsole.InternalWrite(const S: string; bWriteLine: Boolean);\r
+var\r
+ idx : Integer;\r
+begin\r
+ if FLineBreak then\r
+ begin\r
+ FMemo.Lines.Add( S );\r
+ end else\r
+ begin\r
+ idx := FMemo.Lines.Count - 1;\r
+ if idx < 0 then\r
+ begin\r
+ FMemo.Lines.Add( S );\r
+ end;\r
+ FMemo.Lines[idx] := FMemo.Lines[idx] + S;\r
+ end;\r
+ FLineBreak := bWriteLine;\r
+end;\r
+\r
+procedure TGUIConsole.Write(const S: string);\r
+begin\r
+ InternalWrite( S, False);\r
+end;\r
+\r
+procedure TGUIConsole.WriteLine(const S: string);\r
+begin\r
+ InternalWrite( S, True);\r
+end;\r
+\r
+initialization\r
+begin\r
+ FDefaultConsole := TThriftConsole.Create;\r
+ FConsole := FDefaultConsole;\r
+end;\r
+\r
+finalization\r
+begin\r
+ FDefaultConsole.Free;\r
+end;\r
+\r
+end.\r
+\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+{$SCOPEDENUMS ON}\r
+\r
+unit Thrift.Protocol;\r
+\r
+interface\r
+\r
+uses\r
+ Classes,\r
+ SysUtils,\r
+ Contnrs,\r
+ Thrift.Stream,\r
+ Thrift.Collections,\r
+ Thrift.Transport;\r
+\r
+type\r
+\r
+ TType = (\r
+ Stop = 0,\r
+ Void = 1,\r
+ Bool_ = 2,\r
+ Byte_ = 3,\r
+ Double_ = 4,\r
+ I16 = 6,\r
+ I32 = 8,\r
+ I64 = 10,\r
+ String_ = 11,\r
+ Struct = 12,\r
+ Map = 13,\r
+ Set_ = 14,\r
+ List = 15\r
+ );\r
+\r
+ TMessageType = (\r
+ Call = 1,\r
+ Reply = 2,\r
+ Exception = 3,\r
+ Oneway = 4\r
+ );\r
+\r
+ IProtocol = interface;\r
+ IStruct = interface;\r
+\r
+ IProtocolFactory = interface\r
+ ['{7CD64A10-4E9F-4E99-93BF-708A31F4A67B}']\r
+ function GetProtocol( trans: ITransport): IProtocol;\r
+ end;\r
+\r
+ TThriftStringBuilder = class( TStringBuilder)\r
+ public\r
+ function Append(const Value: TBytes): TStringBuilder; overload;\r
+ function Append(const Value: IThriftContainer): TStringBuilder; overload;\r
+ end;\r
+\r
+ TProtocolException = class( Exception )\r
+ public\r
+ const\r
+ UNKNOWN : Integer = 0;\r
+ INVALID_DATA : Integer = 1;\r
+ NEGATIVE_SIZE : Integer = 2;\r
+ SIZE_LIMIT : Integer = 3;\r
+ BAD_VERSION : Integer = 4;\r
+ NOT_IMPLEMENTED : Integer = 5;\r
+ protected\r
+ FType : Integer;\r
+ public\r
+ constructor Create; overload;\r
+ constructor Create( type_: Integer ); overload;\r
+ constructor Create( type_: Integer; const msg: string); overload;\r
+ end;\r
+\r
+ IMap = interface\r
+ ['{30531D97-7E06-4233-B800-C3F53CCD23E7}']\r
+ function GetKeyType: TType;\r
+ procedure SetKeyType( Value: TType);\r
+ function GetValueType: TType;\r
+ procedure SetValueType( Value: TType);\r
+ function GetCount: Integer;\r
+ procedure SetCount( Value: Integer);\r
+ property KeyType: TType read GetKeyType write SetKeyType;\r
+ property ValueType: TType read GetValueType write SetValueType;\r
+ property Count: Integer read GetCount write SetCount;\r
+ end;\r
+\r
+ TMapImpl = class( TInterfacedObject, IMap)\r
+ private\r
+ FValueType: TType;\r
+ FKeyType: TType;\r
+ FCount: Integer;\r
+ protected\r
+ function GetKeyType: TType;\r
+ procedure SetKeyType( Value: TType);\r
+ function GetValueType: TType;\r
+ procedure SetValueType( Value: TType);\r
+ function GetCount: Integer;\r
+ procedure SetCount( Value: Integer);\r
+ public\r
+ constructor Create( AValueType: TType; AKeyType: TType; ACount: Integer); overload;\r
+ constructor Create; overload;\r
+ end;\r
+\r
+ IList = interface\r
+ ['{6763E1EA-A934-4472-904F-0083980B9B87}']\r
+ function GetElementType: TType;\r
+ procedure SetElementType( Value: TType);\r
+ function GetCount: Integer;\r
+ procedure SetCount( Value: Integer);\r
+ property ElementType: TType read GetElementType write SetElementType;\r
+ property Count: Integer read GetCount write SetCount;\r
+ end;\r
+\r
+ TListImpl = class( TInterfacedObject, IList)\r
+ private\r
+ FElementType: TType;\r
+ FCount : Integer;\r
+ protected\r
+ function GetElementType: TType;\r
+ procedure SetElementType( Value: TType);\r
+ function GetCount: Integer;\r
+ procedure SetCount( Value: Integer);\r
+ public\r
+ constructor Create( AElementType: TType; ACount: Integer); overload;\r
+ constructor Create; overload;\r
+ end;\r
+\r
+ ISet = interface\r
+ ['{A8671700-7514-4C1E-8A05-62786872005F}']\r
+ function GetElementType: TType;\r
+ procedure SetElementType( Value: TType);\r
+ function GetCount: Integer;\r
+ procedure SetCount( Value: Integer);\r
+ property ElementType: TType read GetElementType write SetElementType;\r
+ property Count: Integer read GetCount write SetCount;\r
+ end;\r
+\r
+ TSetImpl = class( TInterfacedObject, ISet)\r
+ private\r
+ FCount: Integer;\r
+ FElementType: TType;\r
+ protected\r
+ function GetElementType: TType;\r
+ procedure SetElementType( Value: TType);\r
+ function GetCount: Integer;\r
+ procedure SetCount( Value: Integer);\r
+ public\r
+ constructor Create( AElementType: TType; ACount: Integer); overload;\r
+ constructor Create; overload;\r
+ end;\r
+\r
+ IMessage = interface\r
+ ['{9E368B4A-B1FA-43E7-8CF5-56C66D256CA7}']\r
+ function GetName: string;\r
+ procedure SetName( const Value: string);\r
+ function GetType: TMessageType;\r
+ procedure SetType( Value: TMessageType);\r
+ function GetSeqID: Integer;\r
+ procedure SetSeqID( Value: Integer);\r
+ property Name: string read GetName write SetName;\r
+ property Type_: TMessageType read GetType write SetType;\r
+ property SeqID: Integer read GetSeqID write SetSeqID;\r
+ end;\r
+\r
+ TMessageImpl = class( TInterfacedObject, IMessage )\r
+ private\r
+ FName: string;\r
+ FMessageType: TMessageType;\r
+ FSeqID: Integer;\r
+ protected\r
+ function GetName: string;\r
+ procedure SetName( const Value: string);\r
+ function GetType: TMessageType;\r
+ procedure SetType( Value: TMessageType);\r
+ function GetSeqID: Integer;\r
+ procedure SetSeqID( Value: Integer);\r
+ public\r
+ property Name: string read FName write FName;\r
+ property Type_: TMessageType read FMessageType write FMessageType;\r
+ property SeqID: Integer read FSeqID write FSeqID;\r
+ constructor Create( AName: string; AMessageType: TMessageType; ASeqID: Integer); overload;\r
+ constructor Create; overload;\r
+ end;\r
+\r
+ IField = interface\r
+ ['{F0D43BE5-7883-442E-83FF-0580CC632B72}']\r
+ function GetName: string;\r
+ procedure SetName( const Value: string);\r
+ function GetType: TType;\r
+ procedure SetType( Value: TType);\r
+ function GetId: SmallInt;\r
+ procedure SetId( Value: SmallInt);\r
+ property Name: string read GetName write SetName;\r
+ property Type_: TType read GetType write SetType;\r
+ property Id: SmallInt read GetId write SetId;\r
+ end;\r
+\r
+ TFieldImpl = class( TInterfacedObject, IField)\r
+ private\r
+ FName : string;\r
+ FType : TType;\r
+ FId : SmallInt;\r
+ protected\r
+ function GetName: string;\r
+ procedure SetName( const Value: string);\r
+ function GetType: TType;\r
+ procedure SetType( Value: TType);\r
+ function GetId: SmallInt;\r
+ procedure SetId( Value: SmallInt);\r
+ public\r
+ constructor Create( const AName: string; const AType: TType; AId: SmallInt); overload;\r
+ constructor Create; overload;\r
+ end;\r
+\r
+ TProtocolUtil = class\r
+ public\r
+ class procedure Skip( prot: IProtocol; type_: TType);\r
+ end;\r
+\r
+ IProtocol = interface\r
+ ['{FD95C151-1527-4C96-8134-B902BFC4B4FC}']\r
+ function GetTransport: ITransport;\r
+ procedure WriteMessageBegin( message: IMessage);\r
+ procedure WriteMessageEnd;\r
+ procedure WriteStructBegin(struc: IStruct);\r
+ procedure WriteStructEnd;\r
+ procedure WriteFieldBegin(field: IField);\r
+ procedure WriteFieldEnd;\r
+ procedure WriteFieldStop;\r
+ procedure WriteMapBegin(map: IMap);\r
+ procedure WriteMapEnd;\r
+ procedure WriteListBegin( list: IList);\r
+ procedure WriteListEnd();\r
+ procedure WriteSetBegin( set_: ISet );\r
+ procedure WriteSetEnd();\r
+ procedure WriteBool( b: Boolean);\r
+ procedure WriteByte( b: ShortInt);\r
+ procedure WriteI16( i16: SmallInt);\r
+ procedure WriteI32( i32: Integer);\r
+ procedure WriteI64( i64: Int64);\r
+ procedure WriteDouble( d: Double);\r
+ procedure WriteString( const s: string );\r
+ procedure WriteAnsiString( const s: AnsiString);\r
+ procedure WriteBinary( const b: TBytes);\r
+\r
+ function ReadMessageBegin: IMessage;\r
+ procedure ReadMessageEnd();\r
+ function ReadStructBegin: IStruct;\r
+ procedure ReadStructEnd;\r
+ function ReadFieldBegin: IField;\r
+ procedure ReadFieldEnd();\r
+ function ReadMapBegin: IMap;\r
+ procedure ReadMapEnd();\r
+ function ReadListBegin: IList;\r
+ procedure ReadListEnd();\r
+ function ReadSetBegin: ISet;\r
+ procedure ReadSetEnd();\r
+ function ReadBool: Boolean;\r
+ function ReadByte: ShortInt;\r
+ function ReadI16: SmallInt;\r
+ function ReadI32: Integer;\r
+ function ReadI64: Int64;\r
+ function ReadDouble:Double;\r
+ function ReadBinary: TBytes;\r
+ function ReadString: string;\r
+ function ReadAnsiString: AnsiString;\r
+ property Transport: ITransport read GetTransport;\r
+ end;\r
+\r
+ TProtocolImpl = class abstract( TInterfacedObject, IProtocol)\r
+ protected\r
+ FTrans : ITransport;\r
+ function GetTransport: ITransport;\r
+ public\r
+ procedure WriteMessageBegin( message: IMessage); virtual; abstract;\r
+ procedure WriteMessageEnd; virtual; abstract;\r
+ procedure WriteStructBegin(struc: IStruct); virtual; abstract;\r
+ procedure WriteStructEnd; virtual; abstract;\r
+ procedure WriteFieldBegin(field: IField); virtual; abstract;\r
+ procedure WriteFieldEnd; virtual; abstract;\r
+ procedure WriteFieldStop; virtual; abstract;\r
+ procedure WriteMapBegin(map: IMap); virtual; abstract;\r
+ procedure WriteMapEnd; virtual; abstract;\r
+ procedure WriteListBegin( list: IList); virtual; abstract;\r
+ procedure WriteListEnd(); virtual; abstract;\r
+ procedure WriteSetBegin( set_: ISet ); virtual; abstract;\r
+ procedure WriteSetEnd(); virtual; abstract;\r
+ procedure WriteBool( b: Boolean); virtual; abstract;\r
+ procedure WriteByte( b: ShortInt); virtual; abstract;\r
+ procedure WriteI16( i16: SmallInt); virtual; abstract;\r
+ procedure WriteI32( i32: Integer); virtual; abstract;\r
+ procedure WriteI64( i64: Int64); virtual; abstract;\r
+ procedure WriteDouble( d: Double); virtual; abstract;\r
+ procedure WriteString( const s: string ); virtual;\r
+ procedure WriteAnsiString( const s: AnsiString); virtual;\r
+ procedure WriteBinary( const b: TBytes); virtual; abstract;\r
+\r
+ function ReadMessageBegin: IMessage; virtual; abstract;\r
+ procedure ReadMessageEnd(); virtual; abstract;\r
+ function ReadStructBegin: IStruct; virtual; abstract;\r
+ procedure ReadStructEnd; virtual; abstract;\r
+ function ReadFieldBegin: IField; virtual; abstract;\r
+ procedure ReadFieldEnd(); virtual; abstract;\r
+ function ReadMapBegin: IMap; virtual; abstract;\r
+ procedure ReadMapEnd(); virtual; abstract;\r
+ function ReadListBegin: IList; virtual; abstract;\r
+ procedure ReadListEnd(); virtual; abstract;\r
+ function ReadSetBegin: ISet; virtual; abstract;\r
+ procedure ReadSetEnd(); virtual; abstract;\r
+ function ReadBool: Boolean; virtual; abstract;\r
+ function ReadByte: ShortInt; virtual; abstract;\r
+ function ReadI16: SmallInt; virtual; abstract;\r
+ function ReadI32: Integer; virtual; abstract;\r
+ function ReadI64: Int64; virtual; abstract;\r
+ function ReadDouble:Double; virtual; abstract;\r
+ function ReadBinary: TBytes; virtual; abstract;\r
+ function ReadString: string; virtual;\r
+ function ReadAnsiString: AnsiString; virtual;\r
+\r
+ property Transport: ITransport read GetTransport;\r
+\r
+ constructor Create( trans: ITransport );\r
+ end;\r
+\r
+ IBase = interface\r
+ ['{08D9BAA8-5EAA-410F-B50B-AC2E6E5E4155}']\r
+ function ToString: string;\r
+ procedure Read( iprot: IProtocol);\r
+ procedure Write( iprot: IProtocol);\r
+ end;\r
+\r
+ IStruct = interface\r
+ ['{5DCE39AA-C916-4BC7-A79B-96A0C36B2220}']\r
+ procedure SetName(const Value: string);\r
+ function GetName: string;\r
+ property Name: string read GetName write SetName;\r
+ end;\r
+\r
+ TStructImpl = class( TInterfacedObject, IStruct )\r
+ private\r
+ FName: string;\r
+ protected\r
+ function GetName: string;\r
+ procedure SetName(const Value: string);\r
+ public\r
+ constructor Create( const AName: string);\r
+ end;\r
+\r
+ TBinaryProtocolImpl = class( TProtocolImpl )\r
+ protected\r
+ const\r
+ VERSION_MASK : Cardinal = $ffff0000;\r
+ VERSION_1 : Cardinal = $80010000;\r
+ protected\r
+ FStrictRead : Boolean;\r
+ FStrictWrite : Boolean;\r
+ FReadLength : Integer;\r
+ FCheckReadLength : Boolean;\r
+\r
+ private\r
+ function ReadAll( var buf: TBytes; off: Integer; len: Integer ): Integer;\r
+ function ReadStringBody( size: Integer): string;\r
+ procedure CheckReadLength( len: Integer );\r
+ public\r
+\r
+ type\r
+ TFactory = class( TInterfacedObject, IProtocolFactory)\r
+ protected\r
+ FStrictRead : Boolean;\r
+ FStrictWrite : Boolean;\r
+ public\r
+ function GetProtocol(trans: ITransport): IProtocol;\r
+ constructor Create( AStrictRead, AStrictWrite: Boolean ); overload;\r
+ constructor Create; overload;\r
+ end;\r
+\r
+ constructor Create( trans: ITransport); overload;\r
+ constructor Create( trans: ITransport; strictRead: Boolean; strictWrite: Boolean); overload;\r
+\r
+ procedure WriteMessageBegin( message: IMessage); override;\r
+ procedure WriteMessageEnd; override;\r
+ procedure WriteStructBegin(struc: IStruct); override;\r
+ procedure WriteStructEnd; override;\r
+ procedure WriteFieldBegin(field: IField); override;\r
+ procedure WriteFieldEnd; override;\r
+ procedure WriteFieldStop; override;\r
+ procedure WriteMapBegin(map: IMap); override;\r
+ procedure WriteMapEnd; override;\r
+ procedure WriteListBegin( list: IList); override;\r
+ procedure WriteListEnd(); override;\r
+ procedure WriteSetBegin( set_: ISet ); override;\r
+ procedure WriteSetEnd(); override;\r
+ procedure WriteBool( b: Boolean); override;\r
+ procedure WriteByte( b: ShortInt); override;\r
+ procedure WriteI16( i16: SmallInt); override;\r
+ procedure WriteI32( i32: Integer); override;\r
+ procedure WriteI64( i64: Int64); override;\r
+ procedure WriteDouble( d: Double); override;\r
+ procedure WriteBinary( const b: TBytes); override;\r
+\r
+ function ReadMessageBegin: IMessage; override;\r
+ procedure ReadMessageEnd(); override;\r
+ function ReadStructBegin: IStruct; override;\r
+ procedure ReadStructEnd; override;\r
+ function ReadFieldBegin: IField; override;\r
+ procedure ReadFieldEnd(); override;\r
+ function ReadMapBegin: IMap; override;\r
+ procedure ReadMapEnd(); override;\r
+ function ReadListBegin: IList; override;\r
+ procedure ReadListEnd(); override;\r
+ function ReadSetBegin: ISet; override;\r
+ procedure ReadSetEnd(); override;\r
+ function ReadBool: Boolean; override;\r
+ function ReadByte: ShortInt; override;\r
+ function ReadI16: SmallInt; override;\r
+ function ReadI32: Integer; override;\r
+ function ReadI64: Int64; override;\r
+ function ReadDouble:Double; override;\r
+ function ReadBinary: TBytes; override;\r
+\r
+ procedure SetReadLength( readLength: Integer );\r
+ end;\r
+\r
+implementation\r
+\r
+function ConvertInt64ToDouble( n: Int64): Double;\r
+begin\r
+ ASSERT( SizeOf(n) = SizeOf(Result));\r
+ System.Move( n, Result, SizeOf(Result));\r
+end;\r
+\r
+function ConvertDoubleToInt64( d: Double): Int64;\r
+begin\r
+ ASSERT( SizeOf(d) = SizeOf(Result));\r
+ System.Move( d, Result, SizeOf(Result));\r
+end;\r
+\r
+{ TFieldImpl }\r
+\r
+constructor TFieldImpl.Create(const AName: string; const AType: TType;\r
+ AId: SmallInt);\r
+begin\r
+ FName := AName;\r
+ FType := AType;\r
+ FId := AId;\r
+end;\r
+\r
+constructor TFieldImpl.Create;\r
+begin\r
+ FName := '';\r
+ FType := Low(TType);\r
+ FId := 0;\r
+end;\r
+\r
+function TFieldImpl.GetId: SmallInt;\r
+begin\r
+ Result := FId;\r
+end;\r
+\r
+function TFieldImpl.GetName: string;\r
+begin\r
+ Result := FName;\r
+end;\r
+\r
+function TFieldImpl.GetType: TType;\r
+begin\r
+ Result := FType;\r
+end;\r
+\r
+procedure TFieldImpl.SetId(Value: SmallInt);\r
+begin\r
+ FId := Value;\r
+end;\r
+\r
+procedure TFieldImpl.SetName(const Value: string);\r
+begin\r
+ FName := Value;\r
+end;\r
+\r
+procedure TFieldImpl.SetType(Value: TType);\r
+begin\r
+ FType := Value;\r
+end;\r
+\r
+{ TProtocolImpl }\r
+\r
+constructor TProtocolImpl.Create(trans: ITransport);\r
+begin\r
+ inherited Create;\r
+ FTrans := trans;\r
+end;\r
+\r
+function TProtocolImpl.GetTransport: ITransport;\r
+begin\r
+ Result := FTrans;\r
+end;\r
+\r
+function TProtocolImpl.ReadAnsiString: AnsiString;\r
+var\r
+ b : TBytes;\r
+ len : Integer;\r
+begin\r
+ Result := '';\r
+ b := ReadBinary;\r
+ len := Length( b );\r
+ if len > 0 then\r
+ begin\r
+ SetLength( Result, len);\r
+ System.Move( b[0], Pointer(Result)^, len );\r
+ end;\r
+end;\r
+\r
+function TProtocolImpl.ReadString: string;\r
+begin\r
+ Result := TEncoding.UTF8.GetString( ReadBinary );\r
+end;\r
+\r
+procedure TProtocolImpl.WriteAnsiString(const s: AnsiString);\r
+var\r
+ b : TBytes;\r
+ len : Integer;\r
+begin\r
+ len := Length(s);\r
+ SetLength( b, len);\r
+ if len > 0 then\r
+ begin\r
+ System.Move( Pointer(s)^, b[0], len );\r
+ end;\r
+ WriteBinary( b );\r
+end;\r
+\r
+procedure TProtocolImpl.WriteString(const s: string);\r
+var\r
+ b : TBytes;\r
+begin\r
+ b := TEncoding.UTF8.GetBytes(s);\r
+ WriteBinary( b );\r
+end;\r
+\r
+{ TProtocolUtil }\r
+\r
+class procedure TProtocolUtil.Skip( prot: IProtocol; type_: TType);\r
+begin\r
+\r
+end;\r
+\r
+{ TStructImpl }\r
+\r
+constructor TStructImpl.Create(const AName: string);\r
+begin\r
+ inherited Create;\r
+ FName := AName;\r
+end;\r
+\r
+function TStructImpl.GetName: string;\r
+begin\r
+ Result := FName;\r
+end;\r
+\r
+procedure TStructImpl.SetName(const Value: string);\r
+begin\r
+ FName := Value;\r
+end;\r
+\r
+{ TMapImpl }\r
+\r
+constructor TMapImpl.Create(AValueType, AKeyType: TType; ACount: Integer);\r
+begin\r
+ inherited Create;\r
+ FValueType := AValueType;\r
+ FKeyType := AKeyType;\r
+ FCount := ACount;\r
+end;\r
+\r
+constructor TMapImpl.Create;\r
+begin\r
+\r
+end;\r
+\r
+function TMapImpl.GetCount: Integer;\r
+begin\r
+ Result := FCount;\r
+end;\r
+\r
+function TMapImpl.GetKeyType: TType;\r
+begin\r
+ Result := FKeyType;\r
+end;\r
+\r
+function TMapImpl.GetValueType: TType;\r
+begin\r
+ Result := FValueType;\r
+end;\r
+\r
+procedure TMapImpl.SetCount(Value: Integer);\r
+begin\r
+ FCount := Value;\r
+end;\r
+\r
+procedure TMapImpl.SetKeyType(Value: TType);\r
+begin\r
+ FKeyType := Value;\r
+end;\r
+\r
+procedure TMapImpl.SetValueType(Value: TType);\r
+begin\r
+ FValueType := Value;\r
+end;\r
+\r
+{ IMessage }\r
+\r
+constructor TMessageImpl.Create(AName: string; AMessageType: TMessageType;\r
+ ASeqID: Integer);\r
+begin\r
+ inherited Create;\r
+ FName := AName;\r
+ FMessageType := AMessageType;\r
+ FSeqID := ASeqID;\r
+end;\r
+\r
+constructor TMessageImpl.Create;\r
+begin\r
+ inherited;\r
+end;\r
+\r
+function TMessageImpl.GetName: string;\r
+begin\r
+ Result := FName;\r
+end;\r
+\r
+function TMessageImpl.GetSeqID: Integer;\r
+begin\r
+ Result := FSeqID;\r
+end;\r
+\r
+function TMessageImpl.GetType: TMessageType;\r
+begin\r
+ Result := FMessageType;\r
+end;\r
+\r
+procedure TMessageImpl.SetName(const Value: string);\r
+begin\r
+ FName := Value;\r
+end;\r
+\r
+procedure TMessageImpl.SetSeqID(Value: Integer);\r
+begin\r
+ FSeqID := Value;\r
+end;\r
+\r
+procedure TMessageImpl.SetType(Value: TMessageType);\r
+begin\r
+ FMessageType := Value;\r
+end;\r
+\r
+{ ISet }\r
+\r
+constructor TSetImpl.Create( AElementType: TType; ACount: Integer);\r
+begin\r
+ inherited Create;\r
+ FCount := ACount;\r
+ FElementType := AElementType;\r
+end;\r
+\r
+constructor TSetImpl.Create;\r
+begin\r
+\r
+end;\r
+\r
+function TSetImpl.GetCount: Integer;\r
+begin\r
+ Result := FCount;\r
+end;\r
+\r
+function TSetImpl.GetElementType: TType;\r
+begin\r
+ Result := FElementType;\r
+end;\r
+\r
+procedure TSetImpl.SetCount(Value: Integer);\r
+begin\r
+ FCount := Value;\r
+end;\r
+\r
+procedure TSetImpl.SetElementType(Value: TType);\r
+begin\r
+ FElementType := Value;\r
+end;\r
+\r
+{ IList }\r
+\r
+constructor TListImpl.Create( AElementType: TType; ACount: Integer);\r
+begin\r
+ inherited Create;\r
+ FCount := ACount;\r
+ FElementType := AElementType;\r
+end;\r
+\r
+constructor TListImpl.Create;\r
+begin\r
+\r
+end;\r
+\r
+function TListImpl.GetCount: Integer;\r
+begin\r
+ Result := FCount;\r
+end;\r
+\r
+function TListImpl.GetElementType: TType;\r
+begin\r
+ Result := FElementType;\r
+end;\r
+\r
+procedure TListImpl.SetCount(Value: Integer);\r
+begin\r
+ FCount := Value;\r
+end;\r
+\r
+procedure TListImpl.SetElementType(Value: TType);\r
+begin\r
+ FElementType := Value;\r
+end;\r
+\r
+{ TBinaryProtocolImpl }\r
+\r
+constructor TBinaryProtocolImpl.Create( trans: ITransport);\r
+begin\r
+ Create( trans, False, True);\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.CheckReadLength(len: Integer);\r
+begin\r
+ if FCheckReadLength then\r
+ begin\r
+ Dec( FReadLength, len);\r
+ if FReadLength < 0 then\r
+ begin\r
+ raise Exception.Create( 'Message length exceeded: ' + IntToStr( len ) );\r
+ end;\r
+ end;\r
+end;\r
+\r
+constructor TBinaryProtocolImpl.Create(trans: ITransport; strictRead,\r
+ strictWrite: Boolean);\r
+begin\r
+ inherited Create( trans );\r
+ FStrictRead := strictRead;\r
+ FStrictWrite := strictWrite;\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadAll( var buf: TBytes; off,\r
+ len: Integer): Integer;\r
+begin\r
+ CheckReadLength( len );\r
+ Result := FTrans.ReadAll( buf, off, len );\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadBinary: TBytes;\r
+var\r
+ size : Integer;\r
+ buf : TBytes;\r
+begin\r
+ size := ReadI32;\r
+ CheckReadLength( size );\r
+ SetLength( buf, size );\r
+ FTrans.ReadAll( buf, 0, size);\r
+ Result := buf;\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadBool: Boolean;\r
+begin\r
+ Result := ReadByte = 1;\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadByte: ShortInt;\r
+var\r
+ bin : TBytes;\r
+begin\r
+ SetLength( bin, 1);\r
+ ReadAll( bin, 0, 1 );\r
+ Result := ShortInt( bin[0]);\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadDouble: Double;\r
+begin\r
+ Result := ConvertInt64ToDouble( ReadI64 )\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadFieldBegin: IField;\r
+var\r
+ field : IField;\r
+begin\r
+ field := TFieldImpl.Create;\r
+ field.Type_ := TType( ReadByte);\r
+ if ( field.Type_ <> TType.Stop ) then\r
+ begin\r
+ field.Id := ReadI16;\r
+ end;\r
+ Result := field;\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.ReadFieldEnd;\r
+begin\r
+\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadI16: SmallInt;\r
+var\r
+ i16in : TBytes;\r
+begin\r
+ SetLength( i16in, 2 );\r
+ ReadAll( i16in, 0, 2);\r
+ Result := SmallInt(((i16in[0] and $FF) shl 8) or (i16in[1] and $FF));\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadI32: Integer;\r
+var\r
+ i32in : TBytes;\r
+begin\r
+ SetLength( i32in, 4 );\r
+ ReadAll( i32in, 0, 4);\r
+\r
+ Result := Integer(\r
+ ((i32in[0] and $FF) shl 24) or\r
+ ((i32in[1] and $FF) shl 16) or\r
+ ((i32in[2] and $FF) shl 8) or\r
+ (i32in[3] and $FF));\r
+\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadI64: Int64;\r
+var\r
+ i64in : TBytes;\r
+begin\r
+ SetLength( i64in, 8);\r
+ ReadAll( i64in, 0, 8);\r
+ Result :=\r
+ (Int64( i64in[0] and $FF) shl 56) or\r
+ (Int64( i64in[1] and $FF) shl 48) or\r
+ (Int64( i64in[2] and $FF) shl 40) or\r
+ (Int64( i64in[3] and $FF) shl 32) or\r
+ (Int64( i64in[4] and $FF) shl 24) or\r
+ (Int64( i64in[5] and $FF) shl 16) or\r
+ (Int64( i64in[6] and $FF) shl 8) or\r
+ (Int64( i64in[7] and $FF));\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadListBegin: IList;\r
+var\r
+ list : IList;\r
+begin\r
+ list := TListImpl.Create;\r
+ list.ElementType := TType( ReadByte );\r
+ list.Count := ReadI32;\r
+ Result := list;\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.ReadListEnd;\r
+begin\r
+\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadMapBegin: IMap;\r
+var\r
+ map : IMap;\r
+begin\r
+ map := TMapImpl.Create;\r
+ map.KeyType := TType( ReadByte );\r
+ map.ValueType := TType( ReadByte );\r
+ map.Count := ReadI32;\r
+ Result := map;\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.ReadMapEnd;\r
+begin\r
+\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadMessageBegin: IMessage;\r
+var\r
+ size : Integer;\r
+ version : Integer;\r
+ message : IMessage;\r
+begin\r
+ message := TMessageImpl.Create;\r
+ size := ReadI32;\r
+ if (size < 0) then\r
+ begin\r
+ version := size and Integer( VERSION_MASK);\r
+ if ( version <> Integer( VERSION_1)) then\r
+ begin\r
+ raise TProtocolException.Create(TProtocolException.BAD_VERSION, 'Bad version in ReadMessageBegin: ' + IntToStr(version) );\r
+ end;\r
+ message.Type_ := TMessageType( size and $000000ff);\r
+ message.Name := ReadString;\r
+ message.SeqID := ReadI32;\r
+ end else\r
+ begin\r
+ if FStrictRead then\r
+ begin\r
+ raise TProtocolException.Create( TProtocolException.BAD_VERSION, 'Missing version in readMessageBegin, old client?' );\r
+ end;\r
+ message.Name := ReadStringBody( size );\r
+ message.Type_ := TMessageType( ReadByte );\r
+ message.SeqID := ReadI32;\r
+ end;\r
+ Result := message;\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.ReadMessageEnd;\r
+begin\r
+ inherited;\r
+\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadSetBegin: ISet;\r
+var\r
+ set_ : ISet;\r
+begin\r
+ set_ := TSetImpl.Create;\r
+ set_.ElementType := TType( ReadByte );\r
+ set_.Count := ReadI32;\r
+ Result := set_;\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.ReadSetEnd;\r
+begin\r
+\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadStringBody( size: Integer): string;\r
+var\r
+ buf : TBytes;\r
+begin\r
+ CheckReadLength( size );\r
+ SetLength( buf, size );\r
+ FTrans.ReadAll( buf, 0, size );\r
+ Result := TEncoding.UTF8.GetString( buf);\r
+end;\r
+\r
+function TBinaryProtocolImpl.ReadStructBegin: IStruct;\r
+begin\r
+ Result := TStructImpl.Create('');\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.ReadStructEnd;\r
+begin\r
+ inherited;\r
+\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.SetReadLength(readLength: Integer);\r
+begin\r
+ FReadLength := readLength;\r
+ FCheckReadLength := True;\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteBinary( const b: TBytes);\r
+begin\r
+ WriteI32( Length(b));\r
+ FTrans.Write(b, 0, Length( b));\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteBool(b: Boolean);\r
+begin\r
+ if b then\r
+ begin\r
+ WriteByte( 1 );\r
+ end else\r
+ begin\r
+ WriteByte( 0 );\r
+ end;\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteByte(b: ShortInt);\r
+var\r
+ a : TBytes;\r
+begin\r
+ SetLength( a, 1);\r
+ a[0] := Byte( b );\r
+ FTrans.Write( a, 0, 1 );\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteDouble(d: Double);\r
+begin\r
+ WriteI64(ConvertDoubleToInt64(d));\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteFieldBegin(field: IField);\r
+begin\r
+ WriteByte(ShortInt(field.Type_));\r
+ WriteI16(field.ID);\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteFieldEnd;\r
+begin\r
+\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteFieldStop;\r
+begin\r
+ WriteByte(ShortInt(TType.Stop));\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteI16(i16: SmallInt);\r
+var\r
+ i16out : TBytes;\r
+begin\r
+ SetLength( i16out, 2);\r
+ i16out[0] := Byte($FF and (i16 shr 8));\r
+ i16out[1] := Byte($FF and i16);\r
+ FTrans.Write( i16out );\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteI32(i32: Integer);\r
+var\r
+ i32out : TBytes;\r
+begin\r
+ SetLength( i32out, 4);\r
+ i32out[0] := Byte($FF and (i32 shr 24));\r
+ i32out[1] := Byte($FF and (i32 shr 16));\r
+ i32out[2] := Byte($FF and (i32 shr 8));\r
+ i32out[3] := Byte($FF and i32);\r
+ FTrans.Write( i32out, 0, 4);\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteI64(i64: Int64);\r
+var\r
+ i64out : TBytes;\r
+begin\r
+ SetLength( i64out, 8);\r
+ i64out[0] := Byte($FF and (i64 shr 56));\r
+ i64out[1] := Byte($FF and (i64 shr 48));\r
+ i64out[2] := Byte($FF and (i64 shr 40));\r
+ i64out[3] := Byte($FF and (i64 shr 32));\r
+ i64out[4] := Byte($FF and (i64 shr 24));\r
+ i64out[5] := Byte($FF and (i64 shr 16));\r
+ i64out[6] := Byte($FF and (i64 shr 8));\r
+ i64out[7] := Byte($FF and i64);\r
+ FTrans.Write( i64out, 0, 8);\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteListBegin(list: IList);\r
+begin\r
+ WriteByte(ShortInt(list.ElementType));\r
+ WriteI32(list.Count);\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteListEnd;\r
+begin\r
+\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteMapBegin(map: IMap);\r
+begin\r
+ WriteByte(ShortInt(map.KeyType));\r
+ WriteByte(ShortInt(map.ValueType));\r
+ WriteI32(map.Count);\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteMapEnd;\r
+begin\r
+\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteMessageBegin( message: IMessage);\r
+var\r
+ version : Cardinal;\r
+begin\r
+ if FStrictWrite then\r
+ begin\r
+ version := VERSION_1 or Cardinal( message.Type_);\r
+ WriteI32( Integer( version) );\r
+ WriteString( message.Name);\r
+ WriteI32(message.SeqID);\r
+ end else\r
+ begin\r
+ WriteString(message.Name);\r
+ WriteByte(ShortInt(message.Type_));\r
+ WriteI32(message.SeqID);\r
+ end;\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteMessageEnd;\r
+begin\r
+\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteSetBegin(set_: ISet);\r
+begin\r
+ WriteByte(ShortInt(set_.ElementType));\r
+ WriteI32(set_.Count);\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteSetEnd;\r
+begin\r
+\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteStructBegin(struc: IStruct);\r
+begin\r
+\r
+end;\r
+\r
+procedure TBinaryProtocolImpl.WriteStructEnd;\r
+begin\r
+\r
+end;\r
+\r
+{ TProtocolException }\r
+\r
+constructor TProtocolException.Create;\r
+begin\r
+ inherited Create('');\r
+ FType := UNKNOWN;\r
+end;\r
+\r
+constructor TProtocolException.Create(type_: Integer);\r
+begin\r
+ inherited Create('');\r
+ FType := type_;\r
+end;\r
+\r
+constructor TProtocolException.Create(type_: Integer; const msg: string);\r
+begin\r
+ inherited Create( msg );\r
+ FType := type_;\r
+end;\r
+\r
+{ TThriftStringBuilder }\r
+\r
+function TThriftStringBuilder.Append(const Value: TBytes): TStringBuilder;\r
+begin\r
+ Result := Append( string( RawByteString(Value)) );\r
+end;\r
+\r
+function TThriftStringBuilder.Append(\r
+ const Value: IThriftContainer): TStringBuilder;\r
+begin\r
+ Result := Append( Value.ToString );\r
+end;\r
+\r
+{ TBinaryProtocolImpl.TFactory }\r
+\r
+constructor TBinaryProtocolImpl.TFactory.Create(AStrictRead, AStrictWrite: Boolean);\r
+begin\r
+ FStrictRead := AStrictRead;\r
+ FStrictWrite := AStrictWrite;\r
+end;\r
+\r
+constructor TBinaryProtocolImpl.TFactory.Create;\r
+begin\r
+ Create( False, True )\r
+end;\r
+\r
+function TBinaryProtocolImpl.TFactory.GetProtocol(trans: ITransport): IProtocol;\r
+begin\r
+ Result := TBinaryProtocolImpl.Create( trans );\r
+end;\r
+\r
+end.\r
+\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+ unit Thrift.Server;\r
+\r
+interface\r
+\r
+uses\r
+ SysUtils,\r
+ Thrift,\r
+ Thrift.Protocol,\r
+ Thrift.Transport;\r
+\r
+type\r
+ IServer = interface\r
+ ['{CF9F56C6-BB39-4C7D-877B-43B416572CE6}']\r
+ procedure Serve;\r
+ procedure Stop;\r
+ end;\r
+\r
+ TServerImpl = class abstract( TInterfacedObject, IServer )\r
+ public\r
+ type\r
+ TLogDelegate = reference to procedure( str: string);\r
+ protected\r
+ FProcessor : IProcessor;\r
+ FServerTransport : IServerTransport;\r
+ FInputTransportFactory : ITransportFactory;\r
+ FOutputTransportFactory : ITransportFactory;\r
+ FInputProtocolFactory : IProtocolFactory;\r
+ FOutputProtocolFactory : IProtocolFactory;\r
+ FLogDelegate : TLogDelegate;\r
+\r
+ class procedure DefaultLogDelegate( str: string);\r
+\r
+ procedure Serve; virtual; abstract;\r
+ procedure Stop; virtual; abstract;\r
+ public\r
+ constructor Create(\r
+ AProcessor :IProcessor;\r
+ AServerTransport: IServerTransport;\r
+ AInputTransportFactory : ITransportFactory;\r
+ AOutputTransportFactory : ITransportFactory;\r
+ AInputProtocolFactory : IProtocolFactory;\r
+ AOutputProtocolFactory : IProtocolFactory;\r
+ ALogDelegate : TLogDelegate\r
+ ); overload;\r
+\r
+ constructor Create( AProcessor :IProcessor;\r
+ AServerTransport: IServerTransport); overload;\r
+\r
+ constructor Create(\r
+ AProcessor :IProcessor;\r
+ AServerTransport: IServerTransport;\r
+ ALogDelegate: TLogDelegate\r
+ ); overload;\r
+\r
+ constructor Create(\r
+ AProcessor :IProcessor;\r
+ AServerTransport: IServerTransport;\r
+ ATransportFactory : ITransportFactory\r
+ ); overload;\r
+\r
+ constructor Create(\r
+ AProcessor :IProcessor;\r
+ AServerTransport: IServerTransport;\r
+ ATransportFactory : ITransportFactory;\r
+ AProtocolFactory : IProtocolFactory\r
+ ); overload;\r
+ end;\r
+\r
+ TSimpleServer = class( TServerImpl)\r
+ private\r
+ FStop : Boolean;\r
+ public\r
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport); overload;\r
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport;\r
+ ALogDel: TServerImpl.TLogDelegate); overload;\r
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport;\r
+ ATransportFactory: ITransportFactory); overload;\r
+ constructor Create( AProcessor: IProcessor; AServerTransport: IServerTransport;\r
+ ATransportFactory: ITransportFactory; AProtocolFactory: IProtocolFactory); overload;\r
+\r
+ procedure Serve; override;\r
+ procedure Stop; override;\r
+ end;\r
+\r
+\r
+implementation\r
+\r
+{ TServerImpl }\r
+\r
+constructor TServerImpl.Create(AProcessor: IProcessor;\r
+ AServerTransport: IServerTransport; ALogDelegate: TLogDelegate);\r
+var\r
+ InputFactory, OutputFactory : IProtocolFactory;\r
+ InputTransFactory, OutputTransFactory : ITransportFactory;\r
+\r
+begin\r
+ InputFactory := TBinaryProtocolImpl.TFactory.Create;\r
+ OutputFactory := TBinaryProtocolImpl.TFactory.Create;\r
+ InputTransFactory := TTransportFactoryImpl.Create;\r
+ OutputTransFactory := TTransportFactoryImpl.Create;\r
+\r
+ Create(\r
+ AProcessor,\r
+ AServerTransport,\r
+ InputTransFactory,\r
+ OutputTransFactory,\r
+ InputFactory,\r
+ OutputFactory,\r
+ ALogDelegate\r
+ );\r
+end;\r
+\r
+constructor TServerImpl.Create(AProcessor: IProcessor;\r
+ AServerTransport: IServerTransport);\r
+var\r
+ InputFactory, OutputFactory : IProtocolFactory;\r
+ InputTransFactory, OutputTransFactory : ITransportFactory;\r
+\r
+begin\r
+ InputFactory := TBinaryProtocolImpl.TFactory.Create;\r
+ OutputFactory := TBinaryProtocolImpl.TFactory.Create;\r
+ InputTransFactory := TTransportFactoryImpl.Create;\r
+ OutputTransFactory := TTransportFactoryImpl.Create;\r
+\r
+ Create(\r
+ AProcessor,\r
+ AServerTransport,\r
+ InputTransFactory,\r
+ OutputTransFactory,\r
+ InputFactory,\r
+ OutputFactory,\r
+ DefaultLogDelegate\r
+ );\r
+end;\r
+\r
+constructor TServerImpl.Create(AProcessor: IProcessor;\r
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory);\r
+var\r
+ InputProtocolFactory : IProtocolFactory;\r
+ OutputProtocolFactory : IProtocolFactory;\r
+begin\r
+ InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;\r
+ OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;\r
+\r
+ Create( AProcessor, AServerTransport, ATransportFactory, ATransportFactory,\r
+ InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);\r
+end;\r
+\r
+constructor TServerImpl.Create(AProcessor: IProcessor;\r
+ AServerTransport: IServerTransport; AInputTransportFactory,\r
+ AOutputTransportFactory: ITransportFactory; AInputProtocolFactory,\r
+ AOutputProtocolFactory: IProtocolFactory;\r
+ ALogDelegate : TLogDelegate);\r
+begin\r
+ FProcessor := AProcessor;\r
+ FServerTransport := AServerTransport;\r
+ FInputTransportFactory := AInputTransportFactory;\r
+ FOutputTransportFactory := AOutputTransportFactory;\r
+ FInputProtocolFactory := AInputProtocolFactory;\r
+ FOutputProtocolFactory := AOutputProtocolFactory;\r
+ FLogDelegate := ALogDelegate;\r
+end;\r
+\r
+class procedure TServerImpl.DefaultLogDelegate( str: string);\r
+begin\r
+ Writeln( str );\r
+end;\r
+\r
+constructor TServerImpl.Create(AProcessor: IProcessor;\r
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory;\r
+ AProtocolFactory: IProtocolFactory);\r
+begin\r
+\r
+end;\r
+\r
+{ TSimpleServer }\r
+\r
+constructor TSimpleServer.Create(AProcessor: IProcessor;\r
+ AServerTransport: IServerTransport);\r
+var\r
+ InputProtocolFactory : IProtocolFactory;\r
+ OutputProtocolFactory : IProtocolFactory;\r
+ InputTransportFactory : ITransportFactory;\r
+ OutputTransportFactory : ITransportFactory;\r
+begin\r
+ InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;\r
+ OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;\r
+ InputTransportFactory := TTransportFactoryImpl.Create;\r
+ OutputTransportFactory := TTransportFactoryImpl.Create;\r
+\r
+ inherited Create( AProcessor, AServerTransport, InputTransportFactory,\r
+ OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, DefaultLogDelegate);\r
+end;\r
+\r
+constructor TSimpleServer.Create(AProcessor: IProcessor;\r
+ AServerTransport: IServerTransport; ALogDel: TServerImpl.TLogDelegate);\r
+var\r
+ InputProtocolFactory : IProtocolFactory;\r
+ OutputProtocolFactory : IProtocolFactory;\r
+ InputTransportFactory : ITransportFactory;\r
+ OutputTransportFactory : ITransportFactory;\r
+begin\r
+ InputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;\r
+ OutputProtocolFactory := TBinaryProtocolImpl.TFactory.Create;\r
+ InputTransportFactory := TTransportFactoryImpl.Create;\r
+ OutputTransportFactory := TTransportFactoryImpl.Create;\r
+\r
+ inherited Create( AProcessor, AServerTransport, InputTransportFactory,\r
+ OutputTransportFactory, InputProtocolFactory, OutputProtocolFactory, ALogDel);\r
+end;\r
+\r
+constructor TSimpleServer.Create(AProcessor: IProcessor;\r
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory);\r
+begin\r
+ inherited Create( AProcessor, AServerTransport, ATransportFactory,\r
+ ATransportFactory, TBinaryProtocolImpl.TFactory.Create, TBinaryProtocolImpl.TFactory.Create, DefaultLogDelegate);\r
+end;\r
+\r
+constructor TSimpleServer.Create(AProcessor: IProcessor;\r
+ AServerTransport: IServerTransport; ATransportFactory: ITransportFactory;\r
+ AProtocolFactory: IProtocolFactory);\r
+begin\r
+ inherited Create( AProcessor, AServerTransport, ATransportFactory,\r
+ ATransportFactory, AProtocolFactory, AProtocolFactory, DefaultLogDelegate);\r
+end;\r
+\r
+procedure TSimpleServer.Serve;\r
+var\r
+ client : ITransport;\r
+ InputTransport : ITransport;\r
+ OutputTransport : ITransport;\r
+ InputProtocol : IProtocol;\r
+ OutputProtocol : IProtocol;\r
+begin\r
+ try\r
+ FServerTransport.Listen;\r
+ except\r
+ on E: Exception do\r
+ begin\r
+ FLogDelegate( E.ToString);\r
+ end;\r
+ end;\r
+\r
+ client := nil;\r
+ InputTransport := nil;\r
+ OutputTransport := nil;\r
+ InputProtocol := nil;\r
+ OutputProtocol := nil;\r
+\r
+ while (not FStop) do\r
+ begin\r
+ try\r
+ client := FServerTransport.Accept;\r
+ FLogDelegate( 'Client Connected!');\r
+ InputTransport := FInputTransportFactory.GetTransport( client );\r
+ OutputTransport := FOutputTransportFactory.GetTransport( client );\r
+ InputProtocol := FInputProtocolFactory.GetProtocol( InputTransport );\r
+ OutputProtocol := FOutputProtocolFactory.GetProtocol( OutputTransport );\r
+ while ( FProcessor.Process( InputProtocol, OutputProtocol )) do\r
+ begin\r
+ if FStop then Break;\r
+ end;\r
+ except\r
+ on E: TTransportException do\r
+ begin\r
+ if FStop then\r
+ begin\r
+ FLogDelegate('TSimpleServer was shutting down, caught ' + E.ClassName);\r
+ end;\r
+ end;\r
+ on E: Exception do\r
+ begin\r
+ FLogDelegate( E.ToString );\r
+ end;\r
+ end;\r
+ if InputTransport <> nil then\r
+ begin\r
+ InputTransport.Close;\r
+ end;\r
+ if OutputTransport <> nil then\r
+ begin\r
+ OutputTransport.Close;\r
+ end;\r
+ end;\r
+\r
+ if FStop then\r
+ begin\r
+ try\r
+ FServerTransport.Close;\r
+ except\r
+ on E: TTransportException do\r
+ begin\r
+ FLogDelegate('TServerTranport failed on close: ' + E.Message);\r
+ end;\r
+ end;\r
+ FStop := False;\r
+ end;\r
+end;\r
+\r
+procedure TSimpleServer.Stop;\r
+begin\r
+ FStop := True;\r
+ FServerTransport.Close;\r
+end;\r
+\r
+end.\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+unit Thrift.Stream;\r
+\r
+interface\r
+\r
+uses\r
+ Classes,\r
+ SysUtils,\r
+ SysConst,\r
+ RTLConsts,\r
+ Thrift.Utils,\r
+ ActiveX;\r
+\r
+type\r
+\r
+ IThriftStream = interface\r
+ ['{732621B3-F697-4D76-A1B0-B4DD5A8E4018}']\r
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer);\r
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;\r
+ procedure Open;\r
+ procedure Close;\r
+ procedure Flush;\r
+ function IsOpen: Boolean;\r
+ function ToArray: TBytes;\r
+ end;\r
+\r
+ TThriftStreamImpl = class( TInterfacedObject, IThriftStream)\r
+ private\r
+ procedure CheckSizeAndOffset( const buffer: TBytes; offset: Integer; count: Integer);\r
+ protected\r
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); virtual;\r
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; virtual;\r
+ procedure Open; virtual; abstract;\r
+ procedure Close; virtual; abstract;\r
+ procedure Flush; virtual; abstract;\r
+ function IsOpen: Boolean; virtual; abstract;\r
+ function ToArray: TBytes; virtual; abstract;\r
+ end;\r
+\r
+ TThriftStreamAdapterDelphi = class( TThriftStreamImpl )\r
+ private\r
+ FStream : TStream;\r
+ FOwnsStream : Boolean;\r
+ protected\r
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;\r
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;\r
+ procedure Open; override;\r
+ procedure Close; override;\r
+ procedure Flush; override;\r
+ function IsOpen: Boolean; override;\r
+ function ToArray: TBytes; override;\r
+ public\r
+ constructor Create( AStream: TStream; AOwnsStream : Boolean);\r
+ destructor Destroy; override;\r
+ end;\r
+\r
+ TThriftStreamAdapterCOM = class( TThriftStreamImpl)\r
+ private\r
+ FStream : IStream;\r
+ protected\r
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;\r
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;\r
+ procedure Open; override;\r
+ procedure Close; override;\r
+ procedure Flush; override;\r
+ function IsOpen: Boolean; override;\r
+ function ToArray: TBytes; override;\r
+ public\r
+ constructor Create( AStream: IStream);\r
+ end;\r
+\r
+implementation\r
+\r
+{ TThriftStreamAdapterCOM }\r
+\r
+procedure TThriftStreamAdapterCOM.Close;\r
+begin\r
+ FStream := nil;\r
+end;\r
+\r
+constructor TThriftStreamAdapterCOM.Create(AStream: IStream);\r
+begin\r
+ FStream := AStream;\r
+end;\r
+\r
+procedure TThriftStreamAdapterCOM.Flush;\r
+begin\r
+ if IsOpen then\r
+ begin\r
+ if FStream <> nil then\r
+ begin\r
+ FStream.Commit( STGC_DEFAULT );\r
+ end;\r
+ end;\r
+end;\r
+\r
+function TThriftStreamAdapterCOM.IsOpen: Boolean;\r
+begin\r
+ Result := FStream <> nil;\r
+end;\r
+\r
+procedure TThriftStreamAdapterCOM.Open;\r
+begin\r
+\r
+end;\r
+\r
+function TThriftStreamAdapterCOM.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;\r
+begin\r
+ inherited;\r
+ Result := 0;\r
+ if FStream <> nil then\r
+ begin\r
+ if count > 0 then\r
+ begin\r
+ FStream.Read( @buffer[offset], count, @Result);\r
+ end;\r
+ end;\r
+end;\r
+\r
+function TThriftStreamAdapterCOM.ToArray: TBytes;\r
+var\r
+ statstg: TStatStg;\r
+ len : Integer;\r
+ NewPos : Int64;\r
+ cbRead : Integer;\r
+begin\r
+ FillChar( statstg, SizeOf( statstg), 0);\r
+ len := 0;\r
+ if IsOpen then\r
+ begin\r
+ if Succeeded( FStream.Stat( statstg, STATFLAG_NONAME )) then\r
+ begin\r
+ len := statstg.cbSize;\r
+ end;\r
+ end;\r
+\r
+ SetLength( Result, len );\r
+\r
+ if len > 0 then\r
+ begin\r
+ if Succeeded( FStream.Seek( 0, STREAM_SEEK_SET, NewPos) ) then\r
+ begin\r
+ FStream.Read( @Result[0], len, @cbRead);\r
+ end;\r
+ end;\r
+end;\r
+\r
+procedure TThriftStreamAdapterCOM.Write( const buffer: TBytes; offset: Integer; count: Integer);\r
+var\r
+ nWritten : Integer;\r
+begin\r
+ inherited;\r
+ if IsOpen then\r
+ begin\r
+ if count > 0 then\r
+ begin\r
+ FStream.Write( @buffer[0], count, @nWritten);\r
+ end;\r
+ end;\r
+end;\r
+\r
+{ TThriftStreamImpl }\r
+\r
+procedure TThriftStreamImpl.CheckSizeAndOffset(const buffer: TBytes; offset,\r
+ count: Integer);\r
+var\r
+ len : Integer;\r
+begin\r
+ if count > 0 then\r
+ begin\r
+ len := Length( buffer );\r
+ if (offset < 0) or ( offset >= len) then\r
+ begin\r
+ raise ERangeError.Create( SBitsIndexError );\r
+ end;\r
+ if count > len then\r
+ begin\r
+ raise ERangeError.Create( SBitsIndexError );\r
+ end;\r
+ end;\r
+end;\r
+\r
+function TThriftStreamImpl.Read(var buffer: TBytes; offset,\r
+ count: Integer): Integer;\r
+begin\r
+ Result := 0;\r
+ CheckSizeAndOffset( buffer, offset, count );\r
+end;\r
+\r
+procedure TThriftStreamImpl.Write(const buffer: TBytes; offset, count: Integer);\r
+begin\r
+ CheckSizeAndOffset( buffer, offset, count );\r
+end;\r
+\r
+{ TThriftStreamAdapterDelphi }\r
+\r
+procedure TThriftStreamAdapterDelphi.Close;\r
+begin\r
+ FStream.Free;\r
+ FStream := nil;\r
+ FOwnsStream := False;\r
+end;\r
+\r
+constructor TThriftStreamAdapterDelphi.Create(AStream: TStream; AOwnsStream: Boolean);\r
+begin\r
+ FStream := AStream;\r
+ FOwnsStream := AOwnsStream;\r
+end;\r
+\r
+destructor TThriftStreamAdapterDelphi.Destroy;\r
+begin\r
+ if FOwnsStream then\r
+ begin\r
+ FStream.Free;\r
+ end;\r
+ inherited;\r
+end;\r
+\r
+procedure TThriftStreamAdapterDelphi.Flush;\r
+begin\r
+\r
+end;\r
+\r
+function TThriftStreamAdapterDelphi.IsOpen: Boolean;\r
+begin\r
+ Result := FStream <> nil;\r
+end;\r
+\r
+procedure TThriftStreamAdapterDelphi.Open;\r
+begin\r
+\r
+end;\r
+\r
+function TThriftStreamAdapterDelphi.Read(var buffer: TBytes; offset,\r
+ count: Integer): Integer;\r
+begin\r
+ inherited;\r
+ Result := 0;\r
+ if count > 0 then\r
+ begin\r
+ Result := FStream.Read( Pointer(@buffer[offset])^, count)\r
+ end;\r
+end;\r
+\r
+function TThriftStreamAdapterDelphi.ToArray: TBytes;\r
+var\r
+ OrgPos : Integer;\r
+ len : Integer;\r
+begin\r
+ len := 0;\r
+ if FStream <> nil then\r
+ begin\r
+ len := FStream.Size;\r
+ end;\r
+\r
+ SetLength( Result, len );\r
+\r
+ if len > 0 then\r
+ begin\r
+ OrgPos := FStream.Position;\r
+ try\r
+ FStream.Position := 0;\r
+ FStream.ReadBuffer( Pointer(@Result[0])^, len );\r
+ finally\r
+ FStream.Position := OrgPos;\r
+ end;\r
+ end\r
+end;\r
+\r
+procedure TThriftStreamAdapterDelphi.Write(const buffer: TBytes; offset,\r
+ count: Integer);\r
+begin\r
+ inherited;\r
+ if count > 0 then\r
+ begin\r
+ FStream.Write( Pointer(@buffer[offset])^, count)\r
+ end;\r
+end;\r
+\r
+end.\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+ {$SCOPEDENUMS ON}\r
+\r
+unit Thrift.Transport;\r
+\r
+interface\r
+\r
+uses\r
+ Classes,\r
+ SysUtils,\r
+ Sockets,\r
+ Generics.Collections,\r
+ Thrift.Collections,\r
+ Thrift.Utils,\r
+ Thrift.Stream,\r
+ ActiveX,\r
+ msxml;\r
+\r
+type\r
+ ITransport = interface\r
+ ['{A4A9FC37-D620-44DC-AD21-662D16364CE4}']\r
+ function GetIsOpen: Boolean;\r
+ property IsOpen: Boolean read GetIsOpen;\r
+ function Peek: Boolean;\r
+ procedure Open;\r
+ procedure Close;\r
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer;\r
+ function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer;\r
+ procedure Write( const buf: TBytes); overload;\r
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); overload;\r
+ procedure Flush;\r
+ end;\r
+\r
+ TTransportImpl = class( TInterfacedObject, ITransport)\r
+ protected\r
+ function GetIsOpen: Boolean; virtual; abstract;\r
+ property IsOpen: Boolean read GetIsOpen;\r
+ function Peek: Boolean;\r
+ procedure Open(); virtual; abstract;\r
+ procedure Close(); virtual; abstract;\r
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; virtual; abstract;\r
+ function ReadAll(var buf: TBytes; off: Integer; len: Integer): Integer; virtual;\r
+ procedure Write( const buf: TBytes); overload; virtual;\r
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); overload; virtual; abstract;\r
+ procedure Flush; virtual;\r
+ end;\r
+\r
+ TTransportException = class( Exception )\r
+ public\r
+ type\r
+ TExceptionType = (\r
+ Unknown,\r
+ NotOpen,\r
+ AlreadyOpen,\r
+ TimedOut,\r
+ EndOfFile\r
+ );\r
+ private\r
+ FType : TExceptionType;\r
+ public\r
+ constructor Create( AType: TExceptionType); overload;\r
+ constructor Create( const msg: string); overload;\r
+ constructor Create( AType: TExceptionType; const msg: string); overload;\r
+ property Type_: TExceptionType read FType;\r
+ end;\r
+\r
+ IHTTPClient = interface( ITransport )\r
+ ['{0F5DB8AB-710D-4338-AAC9-46B5734C5057}']\r
+ procedure SetConnectionTimeout(const Value: Integer);\r
+ function GetConnectionTimeout: Integer;\r
+ procedure SetReadTimeout(const Value: Integer);\r
+ function GetReadTimeout: Integer;\r
+ function GetCustomHeaders: IThriftDictionary<string,string>;\r
+ procedure SendRequest;\r
+ property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;\r
+ property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;\r
+ property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;\r
+ end;\r
+\r
+ THTTPClientImpl = class( TTransportImpl, IHTTPClient)\r
+ private\r
+ FUri : string;\r
+ FInputStream : IThriftStream;\r
+ FOutputStream : IThriftStream;\r
+ FConnectionTimeout : Integer;\r
+ FReadTimeout : Integer;\r
+ FCustomHeaders : IThriftDictionary<string,string>;\r
+\r
+ function CreateRequest: IXMLHTTPRequest;\r
+ protected\r
+ function GetIsOpen: Boolean; override;\r
+ procedure Open(); override;\r
+ procedure Close(); override;\r
+ function Read( var buf: TBytes; off: Integer; len: Integer): Integer; override;\r
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); override;\r
+ procedure Flush; override;\r
+\r
+ procedure SetConnectionTimeout(const Value: Integer);\r
+ function GetConnectionTimeout: Integer;\r
+ procedure SetReadTimeout(const Value: Integer);\r
+ function GetReadTimeout: Integer;\r
+ function GetCustomHeaders: IThriftDictionary<string,string>;\r
+ procedure SendRequest;\r
+ property ConnectionTimeout: Integer read GetConnectionTimeout write SetConnectionTimeout;\r
+ property ReadTimeout: Integer read GetReadTimeout write SetReadTimeout;\r
+ property CustomHeaders: IThriftDictionary<string,string> read GetCustomHeaders;\r
+ public\r
+ constructor Create( const AUri: string);\r
+ destructor Destroy; override;\r
+ end;\r
+\r
+ IServerTransport = interface\r
+ ['{BF6B7043-DA22-47BF-8B11-2B88EC55FE12}']\r
+ procedure Listen;\r
+ procedure Close;\r
+ function Accept: ITransport;\r
+ end;\r
+\r
+ TServerTransportImpl = class( TInterfacedObject, IServerTransport)\r
+ protected\r
+ function AcceptImpl: ITransport; virtual; abstract;\r
+ public\r
+ procedure Listen; virtual; abstract;\r
+ procedure Close; virtual; abstract;\r
+ function Accept: ITransport;\r
+ end;\r
+\r
+ ITransportFactory = interface\r
+ ['{DD809446-000F-49E1-9BFF-E0D0DC76A9D7}']\r
+ function GetTransport( ATrans: ITransport): ITransport;\r
+ end;\r
+\r
+ TTransportFactoryImpl = class( TInterfacedObject, ITransportFactory)\r
+ function GetTransport( ATrans: ITransport): ITransport; virtual;\r
+ end;\r
+\r
+ TTcpSocketStreamImpl = class( TThriftStreamImpl )\r
+ private\r
+ FTcpClient : TCustomIpClient;\r
+ protected\r
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;\r
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;\r
+ procedure Open; override;\r
+ procedure Close; override;\r
+ procedure Flush; override;\r
+\r
+ function IsOpen: Boolean; override;\r
+ function ToArray: TBytes; override;\r
+ public\r
+ constructor Create( ATcpClient: TCustomIpClient);\r
+ end;\r
+\r
+ IStreamTransport = interface( ITransport )\r
+ ['{A8479B47-2A3E-4421-A9A0-D5A9EDCC634A}']\r
+ function GetInputStream: IThriftStream;\r
+ function GetOutputStream: IThriftStream;\r
+ property InputStream : IThriftStream read GetInputStream;\r
+ property OutputStream : IThriftStream read GetOutputStream;\r
+ end;\r
+\r
+ TStreamTransportImpl = class( TTransportImpl, IStreamTransport)\r
+ protected\r
+ FInputStream : IThriftStream;\r
+ FOutputStream : IThriftStream;\r
+ protected\r
+ function GetIsOpen: Boolean; override;\r
+\r
+ function GetInputStream: IThriftStream;\r
+ function GetOutputStream: IThriftStream;\r
+ public\r
+ property InputStream : IThriftStream read GetInputStream;\r
+ property OutputStream : IThriftStream read GetOutputStream;\r
+\r
+ procedure Open; override;\r
+ procedure Close; override;\r
+ procedure Flush; override;\r
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;\r
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); override;\r
+ constructor Create( AInputStream : IThriftStream; AOutputStream : IThriftStream);\r
+ destructor Destroy; override;\r
+ end;\r
+\r
+ TBufferedStreamImpl = class( TThriftStreamImpl)\r
+ private\r
+ FStream : IThriftStream;\r
+ FBufSize : Integer;\r
+ FBuffer : TMemoryStream;\r
+ protected\r
+ procedure Write( const buffer: TBytes; offset: Integer; count: Integer); override;\r
+ function Read( var buffer: TBytes; offset: Integer; count: Integer): Integer; override;\r
+ procedure Open; override;\r
+ procedure Close; override;\r
+ procedure Flush; override;\r
+ function IsOpen: Boolean; override;\r
+ function ToArray: TBytes; override;\r
+ public\r
+ constructor Create( AStream: IThriftStream; ABufSize: Integer);\r
+ destructor Destroy; override;\r
+ end;\r
+\r
+ TServerSocketImpl = class( TServerTransportImpl)\r
+ private\r
+ FServer : TTcpServer;\r
+ FPort : Integer;\r
+ FClientTimeout : Integer;\r
+ FUseBufferedSocket : Boolean;\r
+ FOwnsServer : Boolean;\r
+ protected\r
+ function AcceptImpl: ITransport; override;\r
+ public\r
+ constructor Create( AServer: TTcpServer ); overload;\r
+ constructor Create( AServer: TTcpServer; AClientTimeout: Integer); overload;\r
+ constructor Create( APort: Integer); overload;\r
+ constructor Create( APort: Integer; AClientTimeout: Integer); overload;\r
+ constructor Create( APort: Integer; AClientTimeout: Integer;\r
+ AUseBufferedSockets: Boolean); overload;\r
+ destructor Destroy; override;\r
+ procedure Listen; override;\r
+ procedure Close; override;\r
+ end;\r
+\r
+ TBufferedTransportImpl = class( TTransportImpl )\r
+ private\r
+ FInputBuffer : IThriftStream;\r
+ FOutputBuffer : IThriftStream;\r
+ FTransport : IStreamTransport;\r
+ FBufSize : Integer;\r
+\r
+ procedure InitBuffers;\r
+ function GetUnderlyingTransport: ITransport;\r
+ protected\r
+ function GetIsOpen: Boolean; override;\r
+ procedure Flush; override;\r
+ public\r
+ procedure Open(); override;\r
+ procedure Close(); override;\r
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;\r
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); override;\r
+ constructor Create( ATransport : IStreamTransport ); overload;\r
+ constructor Create( ATransport : IStreamTransport; ABufSize: Integer); overload;\r
+ property UnderlyingTransport: ITransport read GetUnderlyingTransport;\r
+ property IsOpen: Boolean read GetIsOpen;\r
+ end;\r
+\r
+ TSocketImpl = class(TStreamTransportImpl)\r
+ private\r
+ FClient : TCustomIpClient;\r
+ FOwnsClient : Boolean;\r
+ FHost : string;\r
+ FPort : Integer;\r
+ FTimeout : Integer;\r
+\r
+ procedure InitSocket;\r
+ protected\r
+ function GetIsOpen: Boolean; override;\r
+ public\r
+ procedure Open; override;\r
+ constructor Create( AClient : TCustomIpClient); overload;\r
+ constructor Create( const AHost: string; APort: Integer); overload;\r
+ constructor Create( const AHost: string; APort: Integer; ATimeout: Integer); overload;\r
+ destructor Destroy; override;\r
+ procedure Close; override;\r
+ property TcpClient: TCustomIpClient read FClient;\r
+ property Host : string read FHost;\r
+ property Port: Integer read FPort;\r
+ end;\r
+\r
+ TFramedTransportImpl = class( TTransportImpl)\r
+ private const\r
+ FHeaderSize : Integer = 4;\r
+ private class var\r
+ FHeader_Dummy : array of Byte;\r
+ protected\r
+ FTransport : ITransport;\r
+ FWriteBuffer : TMemoryStream;\r
+ FReadBuffer : TMemoryStream;\r
+\r
+ procedure InitWriteBuffer;\r
+ procedure ReadFrame;\r
+ public\r
+ type\r
+ TFactory = class( TTransportFactoryImpl )\r
+ public\r
+ function GetTransport( ATrans: ITransport): ITransport; override;\r
+ end;\r
+\r
+{$IF CompilerVersion >= 21.0}\r
+ class constructor Create;\r
+{$IFEND}\r
+ constructor Create; overload;\r
+ constructor Create( ATrans: ITransport); overload;\r
+ destructor Destroy; override;\r
+\r
+ procedure Open(); override;\r
+ function GetIsOpen: Boolean; override;\r
+\r
+ procedure Close(); override;\r
+ function Read(var buf: TBytes; off: Integer; len: Integer): Integer; override;\r
+ procedure Write( const buf: TBytes; off: Integer; len: Integer); override;\r
+ procedure Flush; override;\r
+ end;\r
+\r
+{$IF CompilerVersion < 21.0}\r
+procedure TFramedTransportImpl_Initialize;\r
+{$IFEND}\r
+\r
+implementation\r
+\r
+{ TTransportImpl }\r
+\r
+procedure TTransportImpl.Flush;\r
+begin\r
+\r
+end;\r
+\r
+function TTransportImpl.Peek: Boolean;\r
+begin\r
+ Result := IsOpen;\r
+end;\r
+\r
+function TTransportImpl.ReadAll( var buf: TBytes; off, len: Integer): Integer;\r
+var\r
+ got : Integer;\r
+ ret : Integer;\r
+begin\r
+ got := 0;\r
+ while ( got < len) do\r
+ begin\r
+ ret := Read( buf, off + got, len - got);\r
+ if ( ret <= 0 ) then\r
+ begin\r
+ raise TTransportException.Create( 'Cannot read, Remote side has closed' );\r
+ end;\r
+ got := got + ret;\r
+ end;\r
+ Result := got;\r
+end;\r
+\r
+procedure TTransportImpl.Write( const buf: TBytes);\r
+begin\r
+ Self.Write( buf, 0, Length(buf) );\r
+end;\r
+\r
+{ THTTPClientImpl }\r
+\r
+procedure THTTPClientImpl.Close;\r
+begin\r
+ FInputStream := nil;\r
+ FOutputStream := nil;\r
+end;\r
+\r
+constructor THTTPClientImpl.Create(const AUri: string);\r
+begin\r
+ inherited Create;\r
+ FUri := AUri;\r
+ FCustomHeaders := TThriftDictionaryImpl<string,string>.Create;\r
+ FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);\r
+end;\r
+\r
+function THTTPClientImpl.CreateRequest: IXMLHTTPRequest;\r
+var\r
+ pair : TPair<string,string>;\r
+begin\r
+{$IF CompilerVersion >= 21.0}\r
+ Result := CoXMLHTTP.Create;\r
+{$ELSE}\r
+ Result := CoXMLHTTPRequest.Create;\r
+{$IFEND}\r
+\r
+ Result.open('POST', FUri, False, '', '');\r
+ Result.setRequestHeader( 'Content-Type', 'application/x-thrift');\r
+ Result.setRequestHeader( 'Accept', 'application/x-thrift');\r
+ Result.setRequestHeader( 'User-Agent', 'Delphi/IHTTPClient');\r
+\r
+ for pair in FCustomHeaders do\r
+ begin\r
+ Result.setRequestHeader( pair.Key, pair.Value );\r
+ end;\r
+end;\r
+\r
+destructor THTTPClientImpl.Destroy;\r
+begin\r
+ Close;\r
+ inherited;\r
+end;\r
+\r
+procedure THTTPClientImpl.Flush;\r
+begin\r
+ try\r
+ SendRequest;\r
+ finally\r
+ FOutputStream := nil;\r
+ FOutputStream := TThriftStreamAdapterDelphi.Create( TMemoryStream.Create, True);\r
+ end;\r
+end;\r
+\r
+function THTTPClientImpl.GetConnectionTimeout: Integer;\r
+begin\r
+ Result := FConnectionTimeout;\r
+end;\r
+\r
+function THTTPClientImpl.GetCustomHeaders: IThriftDictionary<string,string>;\r
+begin\r
+ Result := FCustomHeaders;\r
+end;\r
+\r
+function THTTPClientImpl.GetIsOpen: Boolean;\r
+begin\r
+ Result := True;\r
+end;\r
+\r
+function THTTPClientImpl.GetReadTimeout: Integer;\r
+begin\r
+ Result := FReadTimeout;\r
+end;\r
+\r
+procedure THTTPClientImpl.Open;\r
+begin\r
+\r
+end;\r
+\r
+function THTTPClientImpl.Read( var buf: TBytes; off, len: Integer): Integer;\r
+begin\r
+ if FInputStream = nil then\r
+ begin\r
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,\r
+ 'No request has been sent');\r
+ end;\r
+ try\r
+ Result := FInputStream.Read( buf, off, len )\r
+ except\r
+ on E: Exception do\r
+ begin\r
+ raise TTransportException.Create( TTransportException.TExceptionType.Unknown,\r
+ E.Message);\r
+ end;\r
+ end;\r
+end;\r
+\r
+procedure THTTPClientImpl.SendRequest;\r
+var\r
+ xmlhttp : IXMLHTTPRequest;\r
+ ms : TMemoryStream;\r
+ a : TBytes;\r
+ len : Integer;\r
+begin\r
+ xmlhttp := CreateRequest;\r
+\r
+ ms := TMemoryStream.Create;\r
+ try\r
+ a := FOutputStream.ToArray;\r
+ len := Length(a);\r
+ if len > 0 then\r
+ begin\r
+ ms.WriteBuffer( Pointer(@a[0])^, len);\r
+ end;\r
+ ms.Position := 0;\r
+ xmlhttp.send( IUnknown( TStreamAdapter.Create( ms, soReference )));\r
+ FInputStream := nil;\r
+ FInputStream := TThriftStreamAdapterCOM.Create( IUnknown( xmlhttp.responseStream) as IStream);\r
+ finally\r
+ ms.Free;\r
+ end;\r
+end;\r
+\r
+procedure THTTPClientImpl.SetConnectionTimeout(const Value: Integer);\r
+begin\r
+ FConnectionTimeout := Value;\r
+end;\r
+\r
+procedure THTTPClientImpl.SetReadTimeout(const Value: Integer);\r
+begin\r
+ FReadTimeout := Value\r
+end;\r
+\r
+procedure THTTPClientImpl.Write( const buf: TBytes; off, len: Integer);\r
+begin\r
+ FOutputStream.Write( buf, off, len);\r
+end;\r
+\r
+{ TTransportException }\r
+\r
+constructor TTransportException.Create(AType: TExceptionType);\r
+begin\r
+ Create( AType, '' )\r
+end;\r
+\r
+constructor TTransportException.Create(AType: TExceptionType;\r
+ const msg: string);\r
+begin\r
+ inherited Create(msg);\r
+ FType := AType;\r
+end;\r
+\r
+constructor TTransportException.Create(const msg: string);\r
+begin\r
+ inherited Create(msg);\r
+end;\r
+\r
+{ TServerTransportImpl }\r
+\r
+function TServerTransportImpl.Accept: ITransport;\r
+begin\r
+ Result := AcceptImpl;\r
+ if Result = nil then\r
+ begin\r
+ raise TTransportException.Create( 'accept() may not return NULL' );\r
+ end;\r
+end;\r
+\r
+{ TTransportFactoryImpl }\r
+\r
+function TTransportFactoryImpl.GetTransport(ATrans: ITransport): ITransport;\r
+begin\r
+ Result := ATrans;\r
+end;\r
+\r
+{ TServerSocket }\r
+\r
+constructor TServerSocketImpl.Create(AServer: TTcpServer; AClientTimeout: Integer);\r
+begin\r
+ FServer := AServer;\r
+ FClientTimeout := AClientTimeout;\r
+end;\r
+\r
+constructor TServerSocketImpl.Create(AServer: TTcpServer);\r
+begin\r
+ Create( AServer, 0 );\r
+end;\r
+\r
+constructor TServerSocketImpl.Create(APort: Integer);\r
+begin\r
+ Create( APort, 0 );\r
+end;\r
+\r
+function TServerSocketImpl.AcceptImpl: ITransport;\r
+var\r
+ ret : TCustomIpClient;\r
+ ret2 : IStreamTransport;\r
+ ret3 : ITransport;\r
+begin\r
+ if FServer = nil then\r
+ begin\r
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,\r
+ 'No underlying server socket.');\r
+ end;\r
+\r
+ try\r
+ ret := TCustomIpClient.Create(nil);\r
+ if ( not FServer.Accept( ret )) then\r
+ begin\r
+ ret.Free;\r
+ Result := nil;\r
+ Exit;\r
+ end;\r
+\r
+ if ret = nil then\r
+ begin\r
+ Result := nil;\r
+ Exit;\r
+ end;\r
+\r
+ ret2 := TSocketImpl.Create( ret );\r
+ if FUseBufferedSocket then\r
+ begin\r
+ ret3 := TBufferedTransportImpl.Create(ret2);\r
+ Result := ret3;\r
+ end else\r
+ begin\r
+ Result := ret2;\r
+ end;\r
+\r
+ except\r
+ on E: Exception do\r
+ begin\r
+ raise TTransportException.Create( E.ToString );\r
+ end;\r
+ end;\r
+end;\r
+\r
+procedure TServerSocketImpl.Close;\r
+begin\r
+ if FServer <> nil then\r
+ begin\r
+ try\r
+ FServer.Active := False;\r
+ except\r
+ on E: Exception do\r
+ begin\r
+ raise TTransportException.Create('Error on closing socket : ' + E.Message);\r
+ end;\r
+ end;\r
+ end;\r
+end;\r
+\r
+constructor TServerSocketImpl.Create(APort, AClientTimeout: Integer;\r
+ AUseBufferedSockets: Boolean);\r
+begin\r
+ FPort := APort;\r
+ FClientTimeout := AClientTimeout;\r
+ FUseBufferedSocket := AUseBufferedSockets;\r
+ FOwnsServer := True;\r
+ FServer := TTcpServer.Create( nil );\r
+ FServer.BlockMode := bmBlocking;\r
+{$IF CompilerVersion >= 21.0}\r
+ FServer.LocalPort := AnsiString( IntToStr( FPort));\r
+{$ELSE}\r
+ FServer.LocalPort := IntToStr( FPort);\r
+{$IFEND}\r
+end;\r
+\r
+destructor TServerSocketImpl.Destroy;\r
+begin\r
+ if FOwnsServer then\r
+ begin\r
+ FServer.Free;\r
+ end;\r
+ inherited;\r
+end;\r
+\r
+procedure TServerSocketImpl.Listen;\r
+begin\r
+ if FServer <> nil then\r
+ begin\r
+ try\r
+ FServer.Active := True;\r
+ except\r
+ on E: Exception do\r
+ begin\r
+ raise TTransportException.Create('Could not accept on listening socket: ' + E.Message);\r
+ end;\r
+ end;\r
+ end;\r
+end;\r
+\r
+constructor TServerSocketImpl.Create(APort, AClientTimeout: Integer);\r
+begin\r
+ Create( APort, AClientTimeout, False );\r
+end;\r
+\r
+{ TSocket }\r
+\r
+constructor TSocketImpl.Create(AClient : TCustomIpClient);\r
+var\r
+ stream : IThriftStream;\r
+begin\r
+ FClient := AClient;\r
+ stream := TTcpSocketStreamImpl.Create( FClient);\r
+ FInputStream := stream;\r
+ FOutputStream := stream;\r
+end;\r
+\r
+constructor TSocketImpl.Create(const AHost: string; APort: Integer);\r
+begin\r
+ Create( AHost, APort, 0);\r
+end;\r
+\r
+procedure TSocketImpl.Close;\r
+begin\r
+ inherited Close;\r
+ if FClient <> nil then\r
+ begin\r
+ FClient.Free;\r
+ FClient := nil;\r
+ end;\r
+end;\r
+\r
+constructor TSocketImpl.Create(const AHost: string; APort, ATimeout: Integer);\r
+begin\r
+ FHost := AHost;\r
+ FPort := APort;\r
+ FTimeout := ATimeout;\r
+ InitSocket;\r
+end;\r
+\r
+destructor TSocketImpl.Destroy;\r
+begin\r
+ if FOwnsClient then\r
+ begin\r
+ FClient.Free;\r
+ end;\r
+ inherited;\r
+end;\r
+\r
+function TSocketImpl.GetIsOpen: Boolean;\r
+begin\r
+ Result := False;\r
+ if FClient <> nil then\r
+ begin\r
+ Result := FClient.Connected;\r
+ end;\r
+end;\r
+\r
+procedure TSocketImpl.InitSocket;\r
+var\r
+ stream : IThriftStream;\r
+begin\r
+ if FClient <> nil then\r
+ begin\r
+ if FOwnsClient then\r
+ begin\r
+ FClient.Free;\r
+ FClient := nil;\r
+ end;\r
+ end;\r
+ FClient := TTcpClient.Create( nil );\r
+ FOwnsClient := True;\r
+\r
+ stream := TTcpSocketStreamImpl.Create( FClient);\r
+ FInputStream := stream;\r
+ FOutputStream := stream;\r
+\r
+end;\r
+\r
+procedure TSocketImpl.Open;\r
+begin\r
+ if IsOpen then\r
+ begin\r
+ raise TTransportException.Create( TTransportException.TExceptionType.AlreadyOpen,\r
+ 'Socket already connected');\r
+ end;\r
+\r
+ if FHost = '' then\r
+ begin\r
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,\r
+ 'Cannot open null host');\r
+ end;\r
+\r
+ if Port <= 0 then\r
+ begin\r
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen,\r
+ 'Cannot open without port');\r
+ end;\r
+\r
+ if FClient = nil then\r
+ begin\r
+ InitSocket;\r
+ end;\r
+\r
+ FClient.RemoteHost := TSocketHost( Host);\r
+ FClient.RemotePort := TSocketPort( IntToStr( Port));\r
+ FClient.Connect;\r
+\r
+ FInputStream := TTcpSocketStreamImpl.Create( FClient);\r
+ FOutputStream := FInputStream;\r
+end;\r
+\r
+{ TBufferedStream }\r
+\r
+procedure TBufferedStreamImpl.Close;\r
+begin\r
+ Flush;\r
+ FStream := nil;\r
+ FBuffer.Free;\r
+ FBuffer := nil;\r
+end;\r
+\r
+constructor TBufferedStreamImpl.Create(AStream: IThriftStream; ABufSize: Integer);\r
+begin\r
+ FStream := AStream;\r
+ FBufSize := ABufSize;\r
+ FBuffer := TMemoryStream.Create;\r
+end;\r
+\r
+destructor TBufferedStreamImpl.Destroy;\r
+begin\r
+ Close;\r
+ inherited;\r
+end;\r
+\r
+procedure TBufferedStreamImpl.Flush;\r
+var\r
+ buf : TBytes;\r
+ len : Integer;\r
+begin\r
+ if IsOpen then\r
+ begin\r
+ len := FBuffer.Size;\r
+ if len > 0 then\r
+ begin\r
+ SetLength( buf, len );\r
+ FBuffer.Position := 0;\r
+ FBuffer.Read( Pointer(@buf[0])^, len );\r
+ FStream.Write( buf, 0, len );\r
+ end;\r
+ FBuffer.Clear;\r
+ end;\r
+end;\r
+\r
+function TBufferedStreamImpl.IsOpen: Boolean;\r
+begin\r
+ Result := (FBuffer <> nil) and ( FStream <> nil);\r
+end;\r
+\r
+procedure TBufferedStreamImpl.Open;\r
+begin\r
+\r
+end;\r
+\r
+function TBufferedStreamImpl.Read( var buffer: TBytes; offset: Integer; count: Integer): Integer;\r
+var\r
+ nRead : Integer;\r
+ tempbuf : TBytes;\r
+begin\r
+ inherited;\r
+ Result := 0;\r
+ if count > 0 then\r
+ begin\r
+ if IsOpen then\r
+ begin\r
+ if FBuffer.Position >= FBuffer.Size then\r
+ begin\r
+ FBuffer.Clear;\r
+ SetLength( tempbuf, FBufSize);\r
+ nRead := FStream.Read( tempbuf, 0, FBufSize );\r
+ if nRead > 0 then\r
+ begin\r
+ FBuffer.WriteBuffer( Pointer(@tempbuf[0])^, nRead );\r
+ FBuffer.Position := 0;\r
+ end;\r
+ end;\r
+\r
+ if FBuffer.Position < FBuffer.Size then\r
+ begin\r
+ Result := FBuffer.Read( Pointer(@buffer[offset])^, count );\r
+ end;\r
+ end;\r
+ end;\r
+end;\r
+\r
+function TBufferedStreamImpl.ToArray: TBytes;\r
+var\r
+ len : Integer;\r
+begin\r
+ len := 0;\r
+\r
+ if IsOpen then\r
+ begin\r
+ len := FBuffer.Size;\r
+ end;\r
+\r
+ SetLength( Result, len);\r
+\r
+ if len > 0 then\r
+ begin\r
+ FBuffer.Position := 0;\r
+ FBuffer.Read( Pointer(@Result[0])^, len );\r
+ end;\r
+end;\r
+\r
+procedure TBufferedStreamImpl.Write( const buffer: TBytes; offset: Integer; count: Integer);\r
+begin\r
+ inherited;\r
+ if count > 0 then\r
+ begin\r
+ if IsOpen then\r
+ begin\r
+ FBuffer.Write( Pointer(@buffer[offset])^, count );\r
+ if FBuffer.Size > FBufSize then\r
+ begin\r
+ Flush;\r
+ end;\r
+ end;\r
+ end;\r
+end;\r
+\r
+{ TStreamTransportImpl }\r
+\r
+procedure TStreamTransportImpl.Close;\r
+begin\r
+ if FInputStream <> FOutputStream then\r
+ begin\r
+ if FInputStream <> nil then\r
+ begin\r
+ FInputStream := nil;\r
+ end;\r
+ if FOutputStream <> nil then\r
+ begin\r
+ FOutputStream := nil;\r
+ end;\r
+ end else\r
+ begin\r
+ FInputStream := nil;\r
+ FOutputStream := nil;\r
+ end;\r
+end;\r
+\r
+constructor TStreamTransportImpl.Create( AInputStream : IThriftStream; AOutputStream : IThriftStream);\r
+begin\r
+ FInputStream := AInputStream;\r
+ FOutputStream := AOutputStream;\r
+end;\r
+\r
+destructor TStreamTransportImpl.Destroy;\r
+begin\r
+ FInputStream := nil;\r
+ FOutputStream := nil;\r
+ inherited;\r
+end;\r
+\r
+procedure TStreamTransportImpl.Flush;\r
+begin\r
+ if FOutputStream = nil then\r
+ begin\r
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot flush null outputstream' );\r
+ end;\r
+\r
+ FOutputStream.Flush;\r
+end;\r
+\r
+function TStreamTransportImpl.GetInputStream: IThriftStream;\r
+begin\r
+ Result := FInputStream;\r
+end;\r
+\r
+function TStreamTransportImpl.GetIsOpen: Boolean;\r
+begin\r
+ Result := True;\r
+end;\r
+\r
+function TStreamTransportImpl.GetOutputStream: IThriftStream;\r
+begin\r
+ Result := FInputStream;\r
+end;\r
+\r
+procedure TStreamTransportImpl.Open;\r
+begin\r
+\r
+end;\r
+\r
+function TStreamTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;\r
+begin\r
+ if FInputStream = nil then\r
+ begin\r
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot read from null inputstream' );\r
+ end;\r
+ Result := FInputStream.Read( buf, off, len );\r
+end;\r
+\r
+procedure TStreamTransportImpl.Write(const buf: TBytes; off, len: Integer);\r
+begin\r
+ if FOutputStream = nil then\r
+ begin\r
+ raise TTransportException.Create( TTransportException.TExceptionType.NotOpen, 'Cannot read from null outputstream' );\r
+ end;\r
+\r
+ FOutputStream.Write( buf, off, len );\r
+end;\r
+\r
+{ TBufferedTransportImpl }\r
+\r
+constructor TBufferedTransportImpl.Create(ATransport: IStreamTransport);\r
+begin\r
+ Create( ATransport, 1024 );\r
+end;\r
+\r
+procedure TBufferedTransportImpl.Close;\r
+begin\r
+ FTransport.Close;\r
+end;\r
+\r
+constructor TBufferedTransportImpl.Create(ATransport: IStreamTransport;\r
+ ABufSize: Integer);\r
+begin\r
+ FTransport := ATransport;\r
+ FBufSize := ABufSize;\r
+ InitBuffers;\r
+end;\r
+\r
+procedure TBufferedTransportImpl.Flush;\r
+begin\r
+ if FOutputBuffer <> nil then\r
+ begin\r
+ FOutputBuffer.Flush;\r
+ end;\r
+end;\r
+\r
+function TBufferedTransportImpl.GetIsOpen: Boolean;\r
+begin\r
+ Result := FTransport.IsOpen;\r
+end;\r
+\r
+function TBufferedTransportImpl.GetUnderlyingTransport: ITransport;\r
+begin\r
+ Result := FTransport;\r
+end;\r
+\r
+procedure TBufferedTransportImpl.InitBuffers;\r
+begin\r
+ if FTransport.InputStream <> nil then\r
+ begin\r
+ FInputBuffer := TBufferedStreamImpl.Create( FTransport.InputStream, FBufSize );\r
+ end;\r
+ if FTransport.OutputStream <> nil then\r
+ begin\r
+ FOutputBuffer := TBufferedStreamImpl.Create( FTransport.OutputStream, FBufSize );\r
+ end;\r
+end;\r
+\r
+procedure TBufferedTransportImpl.Open;\r
+begin\r
+ FTransport.Open\r
+end;\r
+\r
+function TBufferedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;\r
+begin\r
+ Result := 0;\r
+ if FInputBuffer <> nil then\r
+ begin\r
+ Result := FInputBuffer.Read( buf, off, len );\r
+ end;\r
+end;\r
+\r
+procedure TBufferedTransportImpl.Write(const buf: TBytes; off, len: Integer);\r
+begin\r
+ if FOutputBuffer <> nil then\r
+ begin\r
+ FOutputBuffer.Write( buf, off, len );\r
+ end;\r
+end;\r
+\r
+{ TFramedTransportImpl }\r
+\r
+{$IF CompilerVersion < 21.0}\r
+procedure TFramedTransportImpl_Initialize;\r
+begin\r
+ SetLength( TFramedTransportImpl.FHeader_Dummy, TFramedTransportImpl.FHeaderSize);\r
+ FillChar( TFramedTransportImpl.FHeader_Dummy[0],\r
+ Length( TFramedTransportImpl.FHeader_Dummy) * SizeOf( Byte ), 0);\r
+end;\r
+{$ELSE}\r
+class constructor TFramedTransportImpl.Create;\r
+begin\r
+ SetLength( FHeader_Dummy, FHeaderSize);\r
+ FillChar( FHeader_Dummy[0], Length( FHeader_Dummy) * SizeOf( Byte ), 0);\r
+end;\r
+{$IFEND}\r
+\r
+constructor TFramedTransportImpl.Create;\r
+begin\r
+ InitWriteBuffer;\r
+end;\r
+\r
+procedure TFramedTransportImpl.Close;\r
+begin\r
+ FTransport.Close;\r
+end;\r
+\r
+constructor TFramedTransportImpl.Create(ATrans: ITransport);\r
+begin\r
+ InitWriteBuffer;\r
+ FTransport := ATrans;\r
+end;\r
+\r
+destructor TFramedTransportImpl.Destroy;\r
+begin\r
+ FWriteBuffer.Free;\r
+ FReadBuffer.Free;\r
+ inherited;\r
+end;\r
+\r
+procedure TFramedTransportImpl.Flush;\r
+var\r
+ buf : TBytes;\r
+ len : Integer;\r
+ data_len : Integer;\r
+\r
+begin\r
+ len := FWriteBuffer.Size;\r
+ SetLength( buf, len);\r
+ if len > 0 then\r
+ begin\r
+ System.Move( FWriteBuffer.Memory^, buf[0], len );\r
+ end;\r
+\r
+ data_len := len - FHeaderSize;\r
+ if (data_len < 0) then\r
+ begin\r
+ raise Exception.Create( 'TFramedTransport.Flush: data_len < 0' );\r
+ end;\r
+\r
+ InitWriteBuffer;\r
+\r
+ buf[0] := Byte($FF and (data_len shr 24));\r
+ buf[1] := Byte($FF and (data_len shr 16));\r
+ buf[2] := Byte($FF and (data_len shr 8));\r
+ buf[3] := Byte($FF and data_len);\r
+\r
+ FTransport.Write( buf, 0, len );\r
+ FTransport.Flush;\r
+end;\r
+\r
+function TFramedTransportImpl.GetIsOpen: Boolean;\r
+begin\r
+ Result := FTransport.IsOpen;\r
+end;\r
+\r
+type\r
+ TAccessMemoryStream = class(TMemoryStream)\r
+ end;\r
+\r
+procedure TFramedTransportImpl.InitWriteBuffer;\r
+begin\r
+ FWriteBuffer.Free;\r
+ FWriteBuffer := TMemoryStream.Create;\r
+ TAccessMemoryStream(FWriteBuffer).Capacity := 1024;\r
+ FWriteBuffer.Write( Pointer(@FHeader_Dummy[0])^, FHeaderSize);\r
+end;\r
+\r
+procedure TFramedTransportImpl.Open;\r
+begin\r
+ FTransport.Open;\r
+end;\r
+\r
+function TFramedTransportImpl.Read(var buf: TBytes; off, len: Integer): Integer;\r
+var\r
+ got : Integer;\r
+begin\r
+ if FReadBuffer <> nil then\r
+ begin\r
+ got := FReadBuffer.Read( Pointer(@buf[0])^, len );\r
+ if got > 0 then\r
+ begin\r
+ Result := got;\r
+ Exit;\r
+ end;\r
+ end;\r
+\r
+ ReadFrame;\r
+ Result := FReadBuffer.Read( Pointer(@buf[0])^, len );\r
+end;\r
+\r
+procedure TFramedTransportImpl.ReadFrame;\r
+var\r
+ i32rd : TBytes;\r
+ size : Integer;\r
+ buff : TBytes;\r
+begin\r
+ SetLength( i32rd, FHeaderSize );\r
+ FTransport.ReadAll( i32rd, 0, FHeaderSize);\r
+ size :=\r
+ ((i32rd[0] and $FF) shl 24) or\r
+ ((i32rd[1] and $FF) shl 16) or\r
+ ((i32rd[2] and $FF) shl 8) or\r
+ (i32rd[3] and $FF);\r
+ SetLength( buff, size );\r
+ FTransport.ReadAll( buff, 0, size );\r
+ FReadBuffer.Free;\r
+ FReadBuffer := TMemoryStream.Create;\r
+ FReadBuffer.Write( Pointer(@buff[0])^, size );\r
+ FReadBuffer.Position := 0;\r
+end;\r
+\r
+procedure TFramedTransportImpl.Write(const buf: TBytes; off, len: Integer);\r
+begin\r
+ FWriteBuffer.Write( Pointer(@buf[0])^, len );\r
+end;\r
+\r
+{ TFramedTransport.TFactory }\r
+\r
+function TFramedTransportImpl.TFactory.GetTransport(ATrans: ITransport): ITransport;\r
+begin\r
+ Result := TFramedTransportImpl.Create( ATrans );\r
+end;\r
+\r
+{ TTcpSocketStreamImpl }\r
+\r
+procedure TTcpSocketStreamImpl.Close;\r
+begin\r
+ FTcpClient.Close;\r
+end;\r
+\r
+constructor TTcpSocketStreamImpl.Create(ATcpClient: TCustomIpClient);\r
+begin\r
+ FTcpClient := ATcpClient;\r
+end;\r
+\r
+procedure TTcpSocketStreamImpl.Flush;\r
+begin\r
+\r
+end;\r
+\r
+function TTcpSocketStreamImpl.IsOpen: Boolean;\r
+begin\r
+ Result := FTcpClient.Active;\r
+end;\r
+\r
+procedure TTcpSocketStreamImpl.Open;\r
+begin\r
+ FTcpClient.Open;\r
+end;\r
+\r
+function TTcpSocketStreamImpl.Read(var buffer: TBytes; offset,\r
+ count: Integer): Integer;\r
+begin\r
+ inherited;\r
+ Result := FTcpClient.ReceiveBuf( Pointer(@buffer[offset])^, count);\r
+end;\r
+\r
+function TTcpSocketStreamImpl.ToArray: TBytes;\r
+var\r
+ len : Integer;\r
+begin\r
+ len := 0;\r
+ if IsOpen then\r
+ begin\r
+ len := FTcpClient.BytesReceived;\r
+ end;\r
+\r
+ SetLength( Result, len );\r
+\r
+ if len > 0 then\r
+ begin\r
+ FTcpClient.ReceiveBuf( Pointer(@Result[0])^, len);\r
+ end;\r
+end;\r
+\r
+procedure TTcpSocketStreamImpl.Write(const buffer: TBytes; offset, count: Integer);\r
+begin\r
+ inherited;\r
+ FTcpClient.SendBuf( Pointer(@buffer[offset])^, count);\r
+end;\r
+\r
+{$IF CompilerVersion < 21.0}\r
+initialization\r
+begin\r
+ TFramedTransportImpl_Initialize;\r
+end;\r
+{$IFEND}\r
+\r
+\r
+end.\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+unit Thrift.Utils;\r
+\r
+interface\r
+\r
+function IfValue(B: Boolean; const TrueValue, FalseValue: WideString): string;\r
+\r
+implementation\r
+\r
+function IfValue(B: Boolean; const TrueValue, FalseValue: WideString): string;\r
+begin\r
+ if B then\r
+ Result := TrueValue\r
+ else\r
+ Result := FalseValue;\r
+end;\r
+\r
+end.\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+unit Thrift;\r
+\r
+interface\r
+\r
+uses\r
+ SysUtils, Thrift.Protocol;\r
+\r
+type\r
+ IProcessor = interface\r
+ ['{B1538A07-6CAC-4406-8A4C-AFED07C70A89}']\r
+ function Process( iprot :IProtocol; oprot: IProtocol): Boolean;\r
+ end;\r
+\r
+ TApplicationException = class( SysUtils.Exception )\r
+ public\r
+ type\r
+{$SCOPEDENUMS ON}\r
+ TExceptionType = (
+ Unknown,\r
+ UnknownMethod,\r
+ InvalidMessageType,\r
+ WrongMethodName,\r
+ BadSequenceID,\r
+ MissingResult\r
+ );\r
+{$SCOPEDENUMS OFF}\r
+ private\r
+ FType : TExceptionType;\r
+ public\r
+ constructor Create; overload;\r
+ constructor Create( AType: TExceptionType); overload;\r
+ constructor Create( AType: TExceptionType; const msg: string); overload;\r
+\r
+ class function Read( iprot: IProtocol): TApplicationException;\r
+ procedure Write( oprot: IProtocol );\r
+ end;\r
+\r
+implementation\r
+\r
+{ TApplicationException }\r
+\r
+constructor TApplicationException.Create;\r
+begin\r
+ inherited Create( '' );\r
+end;\r
+\r
+constructor TApplicationException.Create(AType: TExceptionType;\r
+ const msg: string);\r
+begin\r
+ inherited Create( msg );\r
+ FType := AType;\r
+end;\r
+\r
+constructor TApplicationException.Create(AType: TExceptionType);\r
+begin\r
+ inherited Create('');\r
+ FType := AType;\r
+end;\r
+\r
+class function TApplicationException.Read(\r
+ iprot: IProtocol): TApplicationException;\r
+var\r
+ field : IField;\r
+ msg : string;\r
+ typ : TExceptionType;\r
+begin\r
+ msg := '';\r
+ typ := TExceptionType.Unknown;\r
+ while ( True ) do\r
+ begin\r
+ field := iprot.ReadFieldBegin;\r
+ if ( field.Type_ = TType.Stop) then\r
+ begin\r
+ Break;\r
+ end;\r
+\r
+ case field.Id of\r
+ 1 : begin\r
+ if ( field.Type_ = TType.String_) then\r
+ begin\r
+ msg := iprot.ReadString;\r
+ end else\r
+ begin\r
+ TProtocolUtil.Skip( iprot, field.Type_ );\r
+ end;\r
+ end;\r
+\r
+ 2 : begin\r
+ if ( field.Type_ = TType.I32) then\r
+ begin\r
+ typ := TExceptionType( iprot.ReadI32 );\r
+ end else\r
+ begin\r
+ TProtocolUtil.Skip( iprot, field.Type_ );\r
+ end;\r
+ end else\r
+ begin\r
+ TProtocolUtil.Skip( iprot, field.Type_);\r
+ end;\r
+ end;\r
+ iprot.ReadFieldEnd;\r
+ end;\r
+ iprot.ReadStructEnd;\r
+ Result := TApplicationException.Create( typ, msg );\r
+end;\r
+\r
+procedure TApplicationException.Write(oprot: IProtocol);\r
+var\r
+ struc : IStruct;\r
+ field : IField;\r
+\r
+begin\r
+ struc := TStructImpl.Create( 'TApplicationException' );\r
+ field := TFieldImpl.Create;\r
+\r
+ oprot.WriteStructBegin( struc );\r
+ if Message <> '' then\r
+ begin\r
+ field.Name := 'message';\r
+ field.Type_ := TType.String_;\r
+ field.Id := 1;\r
+ oprot.WriteFieldBegin( field );\r
+ oprot.WriteString( Message );\r
+ oprot.WriteFieldEnd;\r
+ end;\r
+\r
+ field.Name := 'type';\r
+ field.Type_ := TType.I32;\r
+ field.Id := 2;\r
+ oprot.WriteFieldBegin(field);\r
+ oprot.WriteI32(Integer(FType));\r
+ oprot.WriteFieldEnd();\r
+ oprot.WriteFieldStop();\r
+ oprot.WriteStructEnd();\r
+end;\r
+\r
+end.\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+unit TestClient;\r
+\r
+interface\r
+\r
+uses\r
+ SysUtils, Classes, Thrift.Protocol, Thrift.Transport, Thrift.Test,\r
+ Generics.Collections, Thrift.Collections, Windows, Thrift.Console,\r
+ DateUtils;\r
+\r
+type\r
+\r
+ TThreadConsole = class\r
+ private\r
+ FThread : TThread;\r
+ public\r
+ procedure Write( const S : string);\r
+ procedure WriteLine( const S : string);\r
+ constructor Create( AThread: TThread);\r
+ end;\r
+\r
+ TClientThread = class( TThread )\r
+ private\r
+ FTransport : ITransport;\r
+ FNumIteration : Integer;\r
+ FConsole : TThreadConsole;\r
+\r
+ procedure ClientTest;\r
+ protected\r
+ procedure Execute; override;\r
+ public\r
+ constructor Create(ATransport: ITransport; ANumIteration: Integer);\r
+ destructor Destroy; override;\r
+ end;\r
+\r
+ TTestClient = class\r
+ private\r
+ class var\r
+ FNumIteration : Integer;\r
+ FNumThread : Integer;\r
+ public\r
+ class procedure Execute( const args: array of string);\r
+ end;\r
+\r
+implementation\r
+\r
+{ TTestClient }\r
+\r
+class procedure TTestClient.Execute(const args: array of string);\r
+var\r
+ i : Integer;\r
+ host : string;\r
+ port : Integer;\r
+ url : string;\r
+ bBuffered : Boolean;\r
+ bFramed : Boolean;\r
+ s : string;\r
+ n : Integer;\r
+ threads : array of TThread;\r
+ dtStart : TDateTime;\r
+ test : Integer;\r
+ thread : TThread;\r
+ trans : ITransport;\r
+ streamtrans : IStreamTransport;\r
+ http : IHTTPClient;\r
+\r
+begin\r
+ bBuffered := False;;\r
+ bFramed := False;\r
+ try\r
+ host := 'localhost';\r
+ port := 9090;\r
+ url := '';\r
+ i := 0;\r
+ try\r
+ while ( i < Length(args) ) do\r
+ begin\r
+ try\r
+ if ( args[i] = '-h') then\r
+ begin\r
+ Inc( i );\r
+ s := args[i];\r
+ n := Pos( ':', s);\r
+ if ( n > 0 ) then\r
+ begin\r
+ host := Copy( s, 1, n - 1);\r
+ port := StrToInt( Copy( s, n + 1, MaxInt));\r
+ end else\r
+ begin\r
+ host := s;\r
+ end;\r
+ end else\r
+ if (args[i] = '-u') then\r
+ begin\r
+ Inc( i );\r
+ url := args[i];\r
+ end else\r
+ if (args[i] = '-n') then\r
+ begin\r
+ Inc( i );\r
+ FNumIteration := StrToInt( args[i] );\r
+ end else\r
+ if (args[i] = '-b') then\r
+ begin\r
+ bBuffered := True;\r
+ Console.WriteLine('Using buffered transport');\r
+ end else\r
+ if (args[i] = '-f' ) or ( args[i] = '-framed') then\r
+ begin\r
+ bFramed := True;\r
+ Console.WriteLine('Using framed transport');\r
+ end else\r
+ if (args[i] = '-t') then\r
+ begin\r
+ Inc( i );\r
+ FNumThread := StrToInt( args[i] );\r
+ end;\r
+ finally\r
+ Inc( i );\r
+ end;\r
+ end;\r
+ except\r
+ on E: Exception do\r
+ begin\r
+ Console.WriteLine( E.Message );\r
+ end;\r
+ end;\r
+\r
+ SetLength( threads, FNumThread);\r
+ dtStart := Now;\r
+\r
+ for test := 0 to FNumThread - 1 do\r
+ begin\r
+ if url = '' then\r
+ begin\r
+ streamtrans := TSocketImpl.Create( host, port );\r
+ trans := streamtrans;\r
+ if bBuffered then\r
+ begin\r
+ trans := TBufferedTransportImpl.Create( streamtrans );\r
+ end;\r
+\r
+ if bFramed then\r
+ begin\r
+ trans := TFramedTransportImpl.Create( trans );\r
+ end;\r
+ end else\r
+ begin\r
+ http := THTTPClientImpl.Create( url );\r
+ trans := http;\r
+ end;\r
+ thread := TClientThread.Create( trans, FNumIteration);\r
+ threads[test] := thread;\r
+{$WARN SYMBOL_DEPRECATED OFF}\r
+ thread.Resume;\r
+{$WARN SYMBOL_DEPRECATED ON}\r
+ end;\r
+\r
+ for test := 0 to FNumThread - 1 do\r
+ begin\r
+ threads[test].WaitFor;\r
+ end;\r
+\r
+ for test := 0 to FNumThread - 1 do\r
+ begin\r
+ threads[test].Free;\r
+ end;\r
+\r
+ Console.Write('Total time: ' + IntToStr( MilliSecondsBetween(Now, dtStart)));\r
+\r
+ except\r
+ on E: Exception do\r
+ begin\r
+ Console.WriteLine( E.Message + ' ST: ' + E.StackTrace );\r
+ end;\r
+ end;\r
+\r
+ Console.WriteLine('');\r
+ Console.WriteLine('done!');\r
+end;\r
+\r
+{ TClientThread }\r
+\r
+procedure TClientThread.ClientTest;\r
+var\r
+ binaryProtocol : TBinaryProtocolImpl;\r
+ client : TThriftTest.Iface;\r
+ s : string;\r
+ i8 : ShortInt;\r
+ i32 : Integer;\r
+ i64 : Int64;\r
+ dub : Double;\r
+ o : IXtruct;\r
+ o2 : IXtruct2;\r
+ i : IXtruct;\r
+ i2 : IXtruct2;\r
+ mapout : IThriftDictionary<Integer,Integer>;\r
+ mapin : IThriftDictionary<Integer,Integer>;\r
+ j : Integer;\r
+ first : Boolean;\r
+ key : Integer;\r
+ listout : IThriftList<Integer>;\r
+ listin : IThriftList<Integer>;\r
+ setout : IHashSet<Integer>;\r
+ setin : IHashSet<Integer>;\r
+ ret : TNumberz;\r
+ uid : Int64;\r
+ mm : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;\r
+ m2 : IThriftDictionary<Integer, Integer>;\r
+ k2 : Integer;\r
+ insane : IInsanity;\r
+ truck : IXtruct;\r
+ whoa : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;\r
+ key64 : Int64;\r
+ val : IThriftDictionary<TNumberz, IInsanity>;\r
+ k2_2 : TNumberz;\r
+ k3 : TNumberz;\r
+ v2 : IInsanity;\r
+ userMap : IThriftDictionary<TNumberz, Int64>;\r
+ xtructs : IThriftList<IXtruct>;\r
+ x : IXtruct;\r
+ arg0 : ShortInt;\r
+ arg1 : Integer;\r
+ arg2 : Int64;\r
+ multiDict : IThriftDictionary<SmallInt, string>;\r
+ arg4 : TNumberz;\r
+ arg5 : Int64;\r
+ StartTick : Cardinal;\r
+ k : Integer;\r
+ proc : TThreadProcedure;\r
+\r
+begin\r
+ binaryProtocol := TBinaryProtocolImpl.Create( FTransport );\r
+ client := TThriftTest.TClient.Create( binaryProtocol );\r
+ try\r
+ if not FTransport.IsOpen then\r
+ begin\r
+ FTransport.Open;\r
+ end;\r
+ except\r
+ on E: Exception do\r
+ begin\r
+ Console.WriteLine( E.Message );\r
+ Exit;\r
+ end;\r
+ end;\r
+\r
+ Console.Write('testException()');\r
+ try\r
+ client.testException('Xception');\r
+ except\r
+ on E: TXception do\r
+ begin\r
+ Console.WriteLine( ' = ' + IntToStr(E.ErrorCode) + ', ' + E.Message_ );\r
+ end;\r
+ end;\r
+\r
+ Console.Write('testVoid()');\r
+ client.testVoid();\r
+ Console.WriteLine(' = void');\r
+\r
+ Console.Write('testString(''Test'')');\r
+ s := client.testString('Test');\r
+ Console.WriteLine(' := ''' + s + '''');\r
+\r
+ Console.Write('testByte(1)');\r
+ i8 := client.testByte(1);\r
+ Console.WriteLine(' := ' + IntToStr( i8 ));\r
+\r
+ Console.Write('testI32(-1)');\r
+ i32 := client.testI32(-1);\r
+ Console.WriteLine(' := ' + IntToStr(i32));\r
+\r
+ Console.Write('testI64(-34359738368)');\r
+ i64 := client.testI64(-34359738368);\r
+ Console.WriteLine(' := ' + IntToStr( i64));\r
+\r
+ Console.Write('testDouble(5.325098235)');\r
+ dub := client.testDouble(5.325098235);\r
+ Console.WriteLine(' := ' + FloatToStr( dub));\r
+\r
+ Console.Write('testStruct({''Zero'', 1, -3, -5})');\r
+ o := TXtructImpl.Create;\r
+ o.String_thing := 'Zero';\r
+ o.Byte_thing := 1;\r
+ o.I32_thing := -3;\r
+ o.I64_thing := -5;\r
+ i := client.testStruct(o);\r
+ Console.WriteLine(' := {''' +\r
+ i.String_thing + ''', ' +\r
+ IntToStr( i.Byte_thing) + ', ' +\r
+ IntToStr( i.I32_thing) + ', ' +\r
+ IntToStr( i.I64_thing) + '}');\r
+\r
+ Console.Write('testNest({1, {''Zero'', 1, -3, -5}, 5})');\r
+ o2 := TXtruct2Impl.Create;\r
+ o2.Byte_thing := 1;\r
+ o2.Struct_thing := o;\r
+ o2.I32_thing := 5;\r
+ i2 := client.testNest(o2);\r
+ i := i2.Struct_thing;\r
+ Console.WriteLine(' := {' + IntToStr( i2.Byte_thing) + ', {''' +\r
+ i.String_thing + ''', ' +\r
+ IntToStr( i.Byte_thing) + ', ' +\r
+ IntToStr( i.I32_thing) + ', ' +\r
+ IntToStr( i.I64_thing) + '}, ' +\r
+ IntToStr( i2.I32_thing) + '}');\r
+\r
+\r
+ mapout := TThriftDictionaryImpl<Integer,Integer>.Create;\r
+\r
+ for j := 0 to 4 do\r
+ begin\r
+ mapout.AddOrSetValue( j, j - 10);\r
+ end;\r
+ Console.Write('testMap({');\r
+ first := True;\r
+ for key in mapout.Keys do\r
+ begin\r
+ if first then\r
+ begin\r
+ first := False;\r
+ end else\r
+ begin\r
+ Console.Write( ', ' );\r
+ end;\r
+ Console.Write( IntToStr( key) + ' => ' + IntToStr( mapout[key]));\r
+ end;\r
+ Console.Write('})');\r
+\r
+ mapin := client.testMap( mapout );\r
+ Console.Write(' = {');\r
+ first := True;\r
+ for key in mapin.Keys do\r
+ begin\r
+ if first then\r
+ begin\r
+ first := False;\r
+ end else\r
+ begin\r
+ Console.Write( ', ' );\r
+ end;\r
+ Console.Write( IntToStr( key) + ' => ' + IntToStr( mapin[key]));\r
+ end;\r
+ Console.WriteLine('}');\r
+\r
+ setout := THashSetImpl<Integer>.Create;\r
+ for j := -2 to 2 do\r
+ begin\r
+ setout.Add( j );\r
+ end;\r
+ Console.Write('testSet({');\r
+ first := True;\r
+ for j in setout do\r
+ begin\r
+ if first then\r
+ begin\r
+ first := False;\r
+ end else\r
+ begin\r
+ Console.Write(', ');\r
+ end;\r
+ Console.Write(IntToStr( j));\r
+ end;\r
+ Console.Write('})');\r
+\r
+ Console.Write(' = {');\r
+\r
+ first := True;\r
+ setin := client.testSet(setout);\r
+ for j in setin do\r
+ begin\r
+ if first then\r
+ begin\r
+ first := False;\r
+ end else\r
+ begin\r
+ Console.Write(', ');\r
+ end;\r
+ Console.Write(IntToStr( j));\r
+ end;\r
+ Console.WriteLine('}');\r
+\r
+ Console.Write('testEnum(ONE)');\r
+ ret := client.testEnum(TNumberz.ONE);\r
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));\r
+\r
+ Console.Write('testEnum(TWO)');\r
+ ret := client.testEnum(TNumberz.TWO);\r
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));\r
+\r
+ Console.Write('testEnum(THREE)');\r
+ ret := client.testEnum(TNumberz.THREE);\r
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));\r
+\r
+ Console.Write('testEnum(FIVE)');\r
+ ret := client.testEnum(TNumberz.FIVE);\r
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));\r
+\r
+ Console.Write('testEnum(EIGHT)');\r
+ ret := client.testEnum(TNumberz.EIGHT);\r
+ Console.WriteLine(' = ' + IntToStr( Integer( ret)));\r
+\r
+ Console.Write('testTypedef(309858235082523)');\r
+ uid := client.testTypedef(309858235082523);\r
+ Console.WriteLine(' = ' + IntToStr( uid));\r
+\r
+ Console.Write('testMapMap(1)');\r
+ mm := client.testMapMap(1);\r
+ Console.Write(' = {');\r
+ for key in mm.Keys do\r
+ begin\r
+ Console.Write( IntToStr( key) + ' => {');\r
+ m2 := mm[key];\r
+ for k2 in m2.Keys do\r
+ begin\r
+ Console.Write( IntToStr( k2) + ' => ' + IntToStr( m2[k2]) + ', ');\r
+ end;\r
+ Console.Write('}, ');\r
+ end;\r
+ Console.WriteLine('}');\r
+\r
+ insane := TInsanityImpl.Create;\r
+ insane.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;\r
+ insane.UserMap.AddOrSetValue( TNumberz.FIVE, 5000);\r
+ truck := TXtructImpl.Create;\r
+ truck.String_thing := 'Truck';\r
+ truck.Byte_thing := 8;\r
+ truck.I32_thing := 8;\r
+ truck.I64_thing := 8;\r
+ insane.Xtructs := TThriftListImpl<IXtruct>.Create;\r
+ insane.Xtructs.Add( truck );\r
+ Console.Write('testInsanity()');\r
+ whoa := client.testInsanity( insane );\r
+ Console.Write(' = {');\r
+ for key64 in whoa.Keys do\r
+ begin\r
+ val := whoa[key64];\r
+ Console.Write( IntToStr( key64) + ' => {');\r
+ for k2_2 in val.Keys do\r
+ begin\r
+ v2 := val[k2_2];\r
+ Console.Write( IntToStr( Integer( k2_2)) + ' => {');\r
+ userMap := v2.UserMap;\r
+ Console.Write('{');\r
+ if userMap <> nil then\r
+ begin\r
+ for k3 in userMap.Keys do\r
+ begin\r
+ Console.Write( IntToStr( Integer( k3)) + ' => ' + IntToStr( userMap[k3]) + ', ');\r
+ end;\r
+ end else\r
+ begin\r
+ Console.Write('null');\r
+ end;\r
+ Console.Write('}, ');\r
+ xtructs := v2.Xtructs;\r
+ Console.Write('{');\r
+\r
+ if xtructs <> nil then\r
+ begin\r
+ for x in xtructs do\r
+ begin\r
+ Console.Write('{"' + x.String_thing + '", ' +\r
+ IntToStr( x.Byte_thing) + ', ' +\r
+ IntToStr( x.I32_thing) + ', ' +\r
+ IntToStr( x.I32_thing) + '}, ');\r
+ end;\r
+ end else\r
+ begin\r
+ Console.Write('null');\r
+ end;\r
+ Console.Write('}');\r
+ Console.Write('}, ');\r
+ end;\r
+ Console.Write('}, ');\r
+ end;\r
+ Console.WriteLine('}');\r
+\r
+ arg0 := 1;\r
+ arg1 := 2;\r
+ arg2 := High(Int64);\r
+\r
+ multiDict := TThriftDictionaryImpl<SmallInt, string>.Create;\r
+ multiDict.AddOrSetValue( 1, 'one');\r
+\r
+ arg4 := TNumberz.FIVE;\r
+ arg5 := 5000000;\r
+ Console.WriteLine('Test Multi(' + IntToStr( arg0) + ',' +\r
+ IntToStr( arg1) + ',' + IntToStr( arg2) + ',' +\r
+ multiDict.ToString + ',' + IntToStr( Integer( arg4)) + ',' +\r
+ IntToStr( arg5) + ')');\r
+\r
+ Console.WriteLine('Test Oneway(1)');\r
+ client.testOneway(1);\r
+\r
+ Console.Write('Test Calltime()');\r
+ StartTick := GetTIckCount;\r
+\r
+ for k := 0 to 1000 - 1 do\r
+ begin\r
+ client.testVoid();\r
+ end;\r
+ Console.WriteLine(' = ' + FloatToStr( (GetTickCount - StartTick) / 1000 ) + ' ms a testVoid() call' );\r
+\r
+end;\r
+\r
+constructor TClientThread.Create(ATransport: ITransport; ANumIteration: Integer);\r
+begin\r
+ inherited Create( True );\r
+ FNumIteration := ANumIteration;\r
+ FTransport := ATransport;\r
+ FConsole := TThreadConsole.Create( Self );\r
+end;\r
+\r
+destructor TClientThread.Destroy;\r
+begin\r
+ FConsole.Free;\r
+ inherited;\r
+end;\r
+\r
+procedure TClientThread.Execute;\r
+var\r
+ i : Integer;\r
+ proc : TThreadProcedure;\r
+begin\r
+ for i := 0 to FNumIteration - 1 do\r
+ begin\r
+ ClientTest;\r
+ end;\r
+\r
+ proc := procedure\r
+ begin\r
+ if FTransport <> nil then\r
+ begin\r
+ FTransport.Close;\r
+ FTransport := nil;\r
+ end;\r
+ end;\r
+\r
+ Synchronize( proc );\r
+end;\r
+\r
+{ TThreadConsole }\r
+\r
+constructor TThreadConsole.Create(AThread: TThread);\r
+begin\r
+ FThread := AThread;\r
+end;\r
+\r
+procedure TThreadConsole.Write(const S: string);\r
+var\r
+ proc : TThreadProcedure;\r
+begin\r
+ proc := procedure\r
+ begin\r
+ Console.Write( S );\r
+ end;\r
+ TThread.Synchronize( FThread, proc);\r
+end;\r
+\r
+procedure TThreadConsole.WriteLine(const S: string);\r
+var\r
+ proc : TThreadProcedure;\r
+begin\r
+ proc := procedure\r
+ begin\r
+ Console.WriteLine( S );\r
+ end;\r
+ TThread.Synchronize( FThread, proc);\r
+end;\r
+\r
+initialization\r
+begin\r
+ TTestClient.FNumIteration := 1;\r
+ TTestClient.FNumThread := 1;\r
+end;\r
+\r
+end.\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+unit TestServer;\r
+\r
+interface\r
+\r
+uses\r
+ SysUtils,\r
+ Generics.Collections,\r
+ Thrift.Console,\r
+ Thrift.Server,\r
+ Thrift.Transport,\r
+ Thrift.Collections,\r
+ Thrift.Utils,\r
+ Thrift.Test,\r
+ Thrift,\r
+ Contnrs;\r
+\r
+type\r
+ TTestServer = class\r
+ public\r
+ type\r
+\r
+ ITestHandler = interface( TThriftTest.Iface )\r
+ procedure SetServer( AServer : IServer );\r
+ end;\r
+\r
+ TTestHandlerImpl = class( TInterfacedObject, ITestHandler )\r
+ private\r
+ FServer : IServer;\r
+ protected\r
+ procedure testVoid();\r
+ function testString(thing: string): string;
+ function testByte(thing: ShortInt): ShortInt;
+ function testI32(thing: Integer): Integer;
+ function testI64(thing: Int64): Int64;
+ function testDouble(thing: Double): Double;
+ function testStruct(thing: IXtruct): IXtruct;
+ function testNest(thing: IXtruct2): IXtruct2;
+ function testMap(thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;
+ function testStringMap(thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;
+ function testSet(thing: IHashSet<Integer>): IHashSet<Integer>;
+ function testList(thing: IThriftList<Integer>): IThriftList<Integer>;
+ function testEnum(thing: TNumberz): TNumberz;
+ function testTypedef(thing: Int64): Int64;
+ function testMapMap(hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;
+ function testInsanity(argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;
+ function testMulti(arg0: ShortInt; arg1: Integer; arg2: Int64; arg3: IThriftDictionary<SmallInt, string>; arg4: TNumberz; arg5: Int64): IXtruct;
+ procedure testException(arg: string);
+ function testMultiException(arg0: string; arg1: string): IXtruct;
+ procedure testOneway(secondsToSleep: Integer);
+\r
+ procedure testStop;\r
+\r
+ procedure SetServer( AServer : IServer );\r
+ end;\r
+\r
+ class procedure Execute( args: array of string);\r
+ end;\r
+\r
+implementation\r
+\r
+{ TTestServer.TTestHandlerImpl }\r
+\r
+procedure TTestServer.TTestHandlerImpl.SetServer(AServer: IServer);\r
+begin\r
+ FServer := AServer;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testByte(thing: ShortInt): ShortInt;\r
+begin\r
+ Console.WriteLine('testByte("' + IntToStr( thing) + '")');\r
+ Result := thing;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testDouble(thing: Double): Double;\r
+begin\r
+ Console.WriteLine('testDouble("' + FloatToStr( thing ) + '")');\r
+ Result := thing;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testEnum(thing: TNumberz): TNumberz;\r
+begin\r
+ Console.WriteLine('testEnum(' + IntToStr( Integer( thing)) + ')');\r
+ Result := thing;\r
+end;\r
+\r
+procedure TTestServer.TTestHandlerImpl.testException(arg: string);\r
+var\r
+ x : TXception;\r
+begin\r
+ Console.WriteLine('testException(' + arg + ')');\r
+ if ( arg = 'Xception') then\r
+ begin\r
+ x := TXception.Create;\r
+ x.ErrorCode := 1001;\r
+ x.Message_ := 'This is an Xception';\r
+ raise x;\r
+ end;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testI32(thing: Integer): Integer;\r
+begin\r
+ Console.WriteLine('testI32("' + IntToStr( thing) + '")');\r
+ Result := thing;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testI64(thing: Int64): Int64;\r
+begin\r
+ Console.WriteLine('testI64("' + IntToStr( thing) + '")');\r
+ Result := thing;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testInsanity(\r
+ argument: IInsanity): IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;\r
+var\r
+ hello, goodbye : IXtruct;\r
+ crazy : IInsanity;\r
+ looney : IInsanity;\r
+ first_map : IThriftDictionary<TNumberz, IInsanity>;\r
+ second_map : IThriftDictionary<TNumberz, IInsanity>;\r
+ insane : IThriftDictionary<Int64, IThriftDictionary<TNumberz, IInsanity>>;\r
+\r
+begin\r
+\r
+ Console.WriteLine('testInsanity()');\r
+ hello := TXtructImpl.Create;\r
+ hello.String_thing := 'hello';\r
+ hello.Byte_thing := 2;\r
+ hello.I32_thing := 2;\r
+ hello.I64_thing := 2;\r
+\r
+ goodbye := TXtructImpl.Create;\r
+ goodbye.String_thing := 'Goodbye4';\r
+ goodbye.Byte_thing := 4;\r
+ goodbye.I32_thing := 4;\r
+ goodbye.I64_thing := 4;\r
+\r
+ crazy := TInsanityImpl.Create;\r
+ crazy.UserMap := TThriftDictionaryImpl<TNumberz, Int64>.Create;\r
+ crazy.UserMap.AddOrSetValue( TNumberz.EIGHT, 8);\r
+ crazy.Xtructs := TThriftListImpl<IXtruct>.Create;\r
+ crazy.Xtructs.Add(goodbye);\r
+\r
+ looney := TInsanityImpl.Create;\r
+ crazy.UserMap.AddOrSetValue( TNumberz.FIVE, 5);\r
+ crazy.Xtructs.Add(hello);\r
+\r
+ first_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;\r
+ second_map := TThriftDictionaryImpl<TNumberz, IInsanity>.Create;\r
+\r
+ first_map.AddOrSetValue( TNumberz.SIX, crazy);\r
+ first_map.AddOrSetValue( TNumberz.THREE, crazy);\r
+\r
+ second_map.AddOrSetValue( TNumberz.SIX, looney);\r
+\r
+ insane := TThriftDictionaryImpl<Int64, IThriftDictionary<TNumberz, IInsanity>>.Create;\r
+\r
+ insane.AddOrSetValue( 1, first_map);\r
+ insane.AddOrSetValue( 2, second_map);\r
+\r
+ Result := insane;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testList(\r
+ thing: IThriftList<Integer>): IThriftList<Integer>;\r
+var\r
+ first : Boolean;\r
+ elem : Integer;\r
+begin\r
+ Console.Write('testList({');\r
+ first := True;\r
+ for elem in thing do\r
+ begin\r
+ if first then\r
+ begin\r
+ first := False;\r
+ end else\r
+ begin\r
+ Console.Write(', ');\r
+ end;\r
+ Console.Write( IntToStr( elem));\r
+ end;\r
+ Console.WriteLine('})');\r
+ Result := thing;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testMap(\r
+ thing: IThriftDictionary<Integer, Integer>): IThriftDictionary<Integer, Integer>;\r
+var\r
+ first : Boolean;\r
+ key : Integer;\r
+begin\r
+ Console.Write('testMap({');\r
+ first := True;\r
+ for key in thing.Keys do\r
+ begin\r
+ if (first) then\r
+ begin\r
+ first := false;\r
+ end else\r
+ begin\r
+ Console.Write(', ');\r
+ end;\r
+ Console.Write(IntToStr(key) + ' => ' + IntToStr( thing[key]));\r
+ end;\r
+ Console.WriteLine('})');\r
+ Result := thing;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.TestMapMap(\r
+ hello: Integer): IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;\r
+var\r
+ mapmap : IThriftDictionary<Integer, IThriftDictionary<Integer, Integer>>;\r
+ pos : IThriftDictionary<Integer, Integer>;\r
+ neg : IThriftDictionary<Integer, Integer>;\r
+ i : Integer;\r
+begin\r
+ Console.WriteLine('testMapMap(' + IntToStr( hello) + ')');\r
+ mapmap := TThriftDictionaryImpl<Integer, IThriftDictionary<Integer, Integer>>.Create;\r
+ pos := TThriftDictionaryImpl<Integer, Integer>.Create;\r
+ neg := TThriftDictionaryImpl<Integer, Integer>.Create;\r
+\r
+ for i := 1 to 4 do\r
+ begin\r
+ pos.AddOrSetValue( i, i);\r
+ neg.AddOrSetValue( -i, -i);\r
+ end;\r
+\r
+ mapmap.AddOrSetValue(4, pos);\r
+ mapmap.AddOrSetValue( -4, neg);\r
+\r
+ Result := mapmap;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testMulti(arg0: ShortInt; arg1: Integer;\r
+ arg2: Int64; arg3: IThriftDictionary<SmallInt, string>; arg4: TNumberz;\r
+ arg5: Int64): IXtruct;\r
+var\r
+ hello : IXtruct;\r
+begin\r
+ Console.WriteLine('testMulti()');\r
+ hello := TXtructImpl.Create;\r
+ hello.String_thing := 'Hello2';\r
+ hello.Byte_thing := arg0;\r
+ hello.I32_thing := arg1;\r
+ hello.I64_thing := arg2;\r
+ Result := hello;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testMultiException(arg0,\r
+ arg1: string): IXtruct;\r
+var\r
+ x : TXception;\r
+ x2 : TXception2;\r
+begin\r
+ Console.WriteLine('testMultiException(' + arg0 + ', ' + arg1 + ')');\r
+ if ( arg0 = 'Xception') then\r
+ begin\r
+ x := TXception.Create;\r
+ x.ErrorCode := 1001;\r
+ x.Message := 'This is an Xception';\r
+ raise x;\r
+ end else\r
+ if ( arg0 = 'Xception2') then\r
+ begin\r
+ x2 := TXception2.Create;\r
+ x2.ErrorCode := 2002;\r
+ x2.Struct_thing := TXtructImpl.Create;\r
+ x2.Struct_thing.String_thing := 'This is an Xception2';\r
+ raise x2;\r
+ end;\r
+\r
+ Result := TXtructImpl.Create;\r
+ Result.String_thing := arg1;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testNest(thing: IXtruct2): IXtruct2;\r
+var\r
+ temp : IXtruct;\r
+begin\r
+ temp := thing.Struct_thing;\r
+ Console.WriteLine('testNest({' +\r
+ IntToStr( thing.Byte_thing) + ', {' +\r
+ '"' + temp.String_thing + '", ' +\r
+ IntToStr( temp.Byte_thing) + ', ' +\r
+ IntToStr( temp.I32_thing) + ', ' +\r
+ IntToStr( temp.I64_thing) + '}, ' +\r
+ IntToStr( temp.I32_thing) + '})');\r
+ Result := thing;\r
+end;\r
+\r
+procedure TTestServer.TTestHandlerImpl.testOneway(secondsToSleep: Integer);\r
+begin\r
+ Console.WriteLine('testOneway(' + IntToStr( secondsToSleep )+ '), sleeping...');\r
+ Sleep(secondsToSleep * 1000);\r
+ Console.WriteLine('testOneway finished');\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testSet(\r
+ thing: IHashSet<Integer>):IHashSet<Integer>;\r
+var\r
+ first : Boolean;\r
+ elem : Integer;\r
+begin\r
+ Console.Write('testSet({');\r
+ first := True;\r
+\r
+ for elem in thing do\r
+ begin\r
+ if first then\r
+ begin\r
+ first := False;\r
+ end else\r
+ begin\r
+ Console.Write( ', ');\r
+ end;\r
+ Console.Write( IntToStr( elem));\r
+ end;\r
+ Console.WriteLine('})');\r
+ Result := thing;\r
+end;\r
+\r
+procedure TTestServer.TTestHandlerImpl.testStop;\r
+begin\r
+ if FServer <> nil then\r
+ begin\r
+ FServer.Stop;\r
+ end;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testString(thing: string): string;\r
+begin\r
+ Console.WriteLine('teststring("' + thing + '")');\r
+ Result := thing;\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testStringMap(\r
+ thing: IThriftDictionary<string, string>): IThriftDictionary<string, string>;\r
+begin\r
+\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testTypedef(thing: Int64): Int64;\r
+begin\r
+ Console.WriteLine('testTypedef(' + IntToStr( thing) + ')');\r
+ Result := thing;\r
+end;\r
+\r
+procedure TTestServer.TTestHandlerImpl.TestVoid;\r
+begin\r
+ Console.WriteLine('testVoid()');\r
+end;\r
+\r
+function TTestServer.TTestHandlerImpl.testStruct(thing: IXtruct): IXtruct;\r
+begin\r
+ Console.WriteLine('testStruct({' +\r
+ '"' + thing.String_thing + '", ' +\r
+ IntToStr( thing.Byte_thing) + ', ' +\r
+ IntToStr( thing.I32_thing) + ', ' +\r
+ IntToStr( thing.I64_thing));\r
+ Result := thing;\r
+end;\r
+\r
+{ TTestServer }\r
+\r
+class procedure TTestServer.Execute(args: array of string);\r
+var\r
+ UseBufferedSockets : Boolean;\r
+ UseFramed : Boolean;\r
+ Port : Integer;\r
+ testHandler : ITestHandler;\r
+ testProcessor : IProcessor;\r
+ ServerSocket : IServerTransport;\r
+ ServerEngine : IServer;\r
+ TransportFactroy : ITransportFactory;\r
+\r
+\r
+begin\r
+ try\r
+ UseBufferedSockets := False;\r
+ UseFramed := False;\r
+ Port := 9090;\r
+\r
+ if ( Length( args) > 0) then\r
+ begin\r
+ Port := StrToIntDef( args[0], Port);\r
+\r
+ if ( Length( args) > 0) then\r
+ begin\r
+ if ( args[0] = 'raw' ) then\r
+ begin\r
+ // as default\r
+ end else\r
+ if ( args[0] = 'buffered' ) then\r
+ begin\r
+ UseBufferedSockets := True;\r
+ end else\r
+ if ( args[0] = 'framed' ) then\r
+ begin\r
+ UseFramed := True;\r
+ end else\r
+ begin\r
+ // Fall back to the older boolean syntax\r
+ UseBufferedSockets := StrToBoolDef( args[1], UseBufferedSockets);\r
+ end\r
+ end\r
+ end;\r
+\r
+ testHandler := TTestHandlerImpl.Create;\r
+\r
+ testProcessor := TThriftTest.TProcessorImpl.Create( testHandler );\r
+ ServerSocket := TServerSocketImpl.Create( Port, 0, UseBufferedSockets );\r
+ if UseFramed then\r
+ begin\r
+ TransportFactroy := TFramedTransportImpl.TFactory.Create;\r
+ ServerEngine := TSimpleServer.Create( testProcessor, ServerSocket,\r
+ TransportFactroy);\r
+ end else\r
+ begin\r
+ ServerEngine := TSimpleServer.Create( testProcessor, ServerSocket);\r
+ end;\r
+\r
+ testHandler.SetServer( ServerEngine);\r
+\r
+ Console.WriteLine('Starting the server on port ' + IntToStr( Port) +\r
+ IfValue(UseBufferedSockets, ' with buffered socket', '') +\r
+ IfValue(useFramed, ' with framed transport', '') +\r
+ '...');\r
+\r
+ serverEngine.Serve;\r
+ testHandler.SetServer( nil);\r
+\r
+ except\r
+ on E: Exception do\r
+ begin\r
+ Console.Write( E.Message);\r
+ end;\r
+ end;\r
+ Console.WriteLine( 'done.');\r
+end;\r
+\r
+end.\r
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+\r
+program client;\r
+\r
+{$APPTYPE CONSOLE}\r
+\r
+uses\r
+ SysUtils,\r
+ TestClient in 'TestClient.pas',\r
+ Thrift.Test in 'gen-delphi\Thrift.Test.pas',\r
+ Thrift in '..\..\..\lib\delphi\src\Thrift.pas',\r
+ Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',\r
+ Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',\r
+ Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',\r
+ Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',\r
+ Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas',\r
+ Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',\r
+ Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas';\r
+\r
+var\r
+ nParamCount : Integer;\r
+ args : array of string;\r
+ i : Integer;\r
+ arg : string;\r
+ s : string;\r
+\r
+begin\r
+ try\r
+ nParamCount := ParamCount;\r
+ SetLength( args, nParamCount);\r
+ for i := 1 to nParamCount do\r
+ begin\r
+ arg := ParamStr( i );\r
+ args[i-1] := arg;\r
+ end;\r
+ TTestClient.Execute( args );\r
+ Readln;\r
+ except\r
+ on E: Exception do\r
+ Writeln(E.ClassName, ': ', E.Message);\r
+ end;\r
+end.\r
+\r
--- /dev/null
+#!/bin/sh
+
+#
+# Licensed to the Apache Software Foundation (ASF) under one
+# or more contributor license agreements. See the NOTICE file
+# distributed with this work for additional information
+# regarding copyright ownership. The ASF licenses this file
+# to you under the Apache License, Version 2.0 (the
+# "License"); you may not use this file except in compliance
+# with the License. You may obtain a copy of the License at
+#
+# http://www.apache.org/licenses/LICENSE-2.0
+#
+# Unless required by applicable law or agreed to in writing,
+# software distributed under the License is distributed on an
+# "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY
+# KIND, either express or implied. See the License for the
+# specific language governing permissions and limitations
+# under the License.
+#
+
+../../../compiler/cpp/thrift --gen delphi -o . ../../../test/ThriftTest.thrift
+
--- /dev/null
+(*\r
+ * Licensed to the Apache Software Foundation (ASF) under one\r
+ * or more contributor license agreements. See the NOTICE file\r
+ * distributed with this work for additional information\r
+ * regarding copyright ownership. The ASF licenses this file\r
+ * to you under the Apache License, Version 2.0 (the\r
+ * "License"); you may not use this file except in compliance\r
+ * with the License. You may obtain a copy of the License at\r
+ *\r
+ * http://www.apache.org/licenses/LICENSE-2.0\r
+ *\r
+ * Unless required by applicable law or agreed to in writing,\r
+ * software distributed under the License is distributed on an\r
+ * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY\r
+ * KIND, either express or implied. See the License for the\r
+ * specific language governing permissions and limitations\r
+ * under the License.\r
+ *)\r
+\r
+program server;\r
+\r
+{$APPTYPE CONSOLE}\r
+\r
+uses\r
+ SysUtils,\r
+ TestServer in 'TestServer.pas',\r
+ Thrift.Test in 'gen-delphi\Thrift.Test.pas',\r
+ Thrift in '..\..\..\lib\delphi\src\Thrift.pas',\r
+ Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas',\r
+ Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas',\r
+ Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas',\r
+ Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas',\r
+ Thrift.Console in '..\..\..\lib\delphi\src\Thrift.Console.pas',\r
+ Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas',\r
+ Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas';\r
+\r
+var\r
+ nParamCount : Integer;\r
+ args : array of string;\r
+ i : Integer;\r
+ arg : string;\r
+ s : string;\r
+\r
+begin\r
+ try\r
+ nParamCount := ParamCount;\r
+ SetLength( args, nParamCount);\r
+ for i := 1 to nParamCount do\r
+ begin\r
+ arg := ParamStr( i );\r
+ args[i-1] := arg;\r
+ end;\r
+ TTestServer.Execute( args );\r
+ Readln;\r
+ except\r
+ on E: Exception do\r
+ Writeln(E.ClassName, ': ', E.Message);\r
+ end;\r
+end.\r
+\r
+\r
+\r
namespace py.twisted ThriftTest
namespace go ThriftTest
namespace php ThriftTest
+namespace delphi Thrift.Test
namespace * thrift.test
/**
Code Review / common / thrift.git / commitdiff
