]>
Commit | Line | Data |
---|---|---|
f67539c2 TL |
1 | (* |
2 | * Licensed to the Apache Software Foundation (ASF) under one | |
3 | * or more contributor license agreements. See the NOTICE file | |
4 | * distributed with this work for additional information | |
5 | * regarding copyright ownership. The ASF licenses this file | |
6 | * to you under the Apache License, Version 2.0 (the | |
7 | * "License"); you may not use this file except in compliance | |
8 | * with the License. You may obtain a copy of the License at | |
9 | * | |
10 | * http://www.apache.org/licenses/LICENSE-2.0 | |
11 | * | |
12 | * Unless required by applicable law or agreed to in writing, | |
13 | * software distributed under the License is distributed on an | |
14 | * "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY | |
15 | * KIND, either express or implied. See the License for the | |
16 | * specific language governing permissions and limitations | |
17 | * under the License. | |
18 | *) | |
19 | program DelphiServer; | |
20 | ||
21 | {$APPTYPE CONSOLE} | |
22 | {$D 'Copyright (c) 2012 The Apache Software Foundation'} | |
23 | ||
24 | {$Q+} // throws exceptions on numeric overflows | |
25 | ||
26 | uses | |
27 | SysUtils, | |
28 | Generics.Collections, | |
29 | Thrift in '..\..\..\lib\delphi\src\Thrift.pas', | |
30 | Thrift.Collections in '..\..\..\lib\delphi\src\Thrift.Collections.pas', | |
31 | Thrift.Exception in '..\..\..\lib\delphi\src\Thrift.Exception.pas', | |
32 | Thrift.Utils in '..\..\..\lib\delphi\src\Thrift.Utils.pas', | |
33 | Thrift.Stream in '..\..\..\lib\delphi\src\Thrift.Stream.pas', | |
34 | Thrift.Protocol in '..\..\..\lib\delphi\src\Thrift.Protocol.pas', | |
35 | Thrift.Server in '..\..\..\lib\delphi\src\Thrift.Server.pas', | |
36 | Thrift.Transport in '..\..\..\lib\delphi\src\Thrift.Transport.pas', | |
37 | Thrift.WinHTTP in '..\..\..\lib\delphi\src\Thrift.WinHTTP.pas', | |
38 | Shared in '..\..\gen-delphi\Shared.pas', | |
39 | Tutorial in '..\..\gen-delphi\Tutorial.pas'; | |
40 | ||
41 | ||
42 | type | |
43 | TCalculatorHandler = class( TInterfacedObject, TCalculator.Iface) | |
44 | protected | |
45 | FLog : TDictionary< Integer, ISharedStruct>; | |
46 | ||
47 | // TSharedService.Iface | |
48 | function getStruct(key: Integer): ISharedStruct; | |
49 | ||
50 | // TCalculator.Iface | |
51 | procedure ping(); | |
52 | function add(num1: Integer; num2: Integer): Integer; | |
53 | function calculate(logid: Integer; const w: IWork): Integer; | |
54 | procedure zip(); | |
55 | ||
56 | public | |
57 | constructor Create; | |
58 | destructor Destroy; override; | |
59 | ||
60 | end; | |
61 | ||
62 | DelphiTutorialServer = class | |
63 | public | |
64 | class procedure Main; | |
65 | end; | |
66 | ||
67 | ||
68 | //--- TCalculatorHandler --------------------------------------------------- | |
69 | ||
70 | ||
71 | constructor TCalculatorHandler.Create; | |
72 | begin | |
73 | inherited Create; | |
74 | FLog := TDictionary< Integer, ISharedStruct>.Create(); | |
75 | end; | |
76 | ||
77 | ||
78 | destructor TCalculatorHandler.Destroy; | |
79 | begin | |
80 | try | |
81 | FreeAndNil( FLog); | |
82 | finally | |
83 | inherited Destroy; | |
84 | end; | |
85 | end; | |
86 | ||
87 | ||
88 | procedure TCalculatorHandler.ping; | |
89 | begin | |
90 | WriteLn( 'ping()'); | |
91 | end; | |
92 | ||
93 | ||
94 | function TCalculatorHandler.add(num1: Integer; num2: Integer): Integer; | |
95 | begin | |
96 | WriteLn( Format( 'add( %d, %d)', [num1, num2])); | |
97 | result := num1 + num2; | |
98 | end; | |
99 | ||
100 | ||
101 | function TCalculatorHandler.calculate(logid: Integer; const w: IWork): Integer; | |
102 | var entry : ISharedStruct; | |
103 | begin | |
104 | try | |
105 | WriteLn( Format('calculate( %d, [%d,%d,%d])', [logid, Ord(w.Op), w.Num1, w.Num2])); | |
106 | ||
107 | case w.Op of | |
108 | TOperation.ADD : result := w.Num1 + w.Num2; | |
109 | TOperation.SUBTRACT : result := w.Num1 - w.Num2; | |
110 | TOperation.MULTIPLY : result := w.Num1 * w.Num2; | |
111 | TOperation.DIVIDE : result := Round( w.Num1 / w.Num2); | |
112 | else | |
113 | raise TInvalidOperation.Create( Ord(w.Op), 'Unknown operation'); | |
114 | end; | |
115 | ||
116 | except | |
117 | on e:Thrift.TException do raise; // let Thrift Exceptions pass through | |
118 | on e:Exception do raise TInvalidOperation.Create( Ord(w.Op), e.Message); // repackage all other | |
119 | end; | |
120 | ||
121 | entry := TSharedStructImpl.Create; | |
122 | entry.Key := logid; | |
123 | entry.Value := IntToStr( result); | |
124 | FLog.AddOrSetValue( logid, entry); | |
125 | end; | |
126 | ||
127 | ||
128 | function TCalculatorHandler.getStruct(key: Integer): ISharedStruct; | |
129 | begin | |
130 | WriteLn( Format( 'getStruct(%d)', [key])); | |
131 | result := FLog[key]; | |
132 | end; | |
133 | ||
134 | ||
135 | procedure TCalculatorHandler.zip; | |
136 | begin | |
137 | WriteLn( 'zip()'); | |
138 | end; | |
139 | ||
140 | ||
141 | //--- DelphiTutorialServer ---------------------------------------------------------------------- | |
142 | ||
143 | ||
144 | class procedure DelphiTutorialServer.Main; | |
145 | var handler : TCalculator.Iface; | |
146 | processor : IProcessor; | |
147 | transport : IServerTransport; | |
148 | server : IServer; | |
149 | begin | |
150 | try | |
151 | handler := TCalculatorHandler.Create; | |
152 | processor := TCalculator.TProcessorImpl.Create( handler); | |
153 | transport := TServerSocketImpl.Create( 9090); | |
154 | server := TSimpleServer.Create( processor, transport); | |
155 | ||
156 | WriteLn( 'Starting the server...'); | |
157 | server.Serve(); | |
158 | ||
159 | except | |
160 | on e: Exception do WriteLn( e.Message); | |
161 | end; | |
162 | ||
163 | WriteLn('done.'); | |
164 | end; | |
165 | ||
166 | ||
167 | begin | |
168 | try | |
169 | DelphiTutorialServer.Main; | |
170 | except | |
171 | on E: Exception do | |
172 | Writeln(E.ClassName, ': ', E.Message); | |
173 | end; | |
174 | end. |