* Replaced fphttpclient with indy10.
* Added compression support
| @ -103,6 +103,9 @@ Once the first none-empty line is unrecognized (no command found), the parser wi | ||||
|     This can be repeated multiple times but will only be used when Method == POST. | ||||
|     The Content-Type header is set automatically too. | ||||
| 
 | ||||
| `Compress[ed]` | ||||
| :   Adds support for gzip,deflate compression to the connection. | ||||
| 
 | ||||
| `Call <URL>` | ||||
| :   This prepares the actual call by providing the URL to be called. | ||||
|     Variables in the form of `@<variablename>` are replaced accordingly. | ||||
|  | ||||
| @ -24,11 +24,25 @@ interface | ||||
| 
 | ||||
| uses | ||||
|   Classes, SysUtils, CustApp, | ||||
|   IniFiles, fphttpclient, jsonparser, JTemplate, | ||||
|   UFilter; | ||||
|   IniFiles, jsonparser, JTemplate, | ||||
|   UFilter, IdHTTP, IdMultipartFormData; | ||||
| 
 | ||||
| type | ||||
| 
 | ||||
|   { TRestHTTP } | ||||
| 
 | ||||
|   TRestHTTP = class(TIdHTTP) | ||||
|   public | ||||
|     procedure Perform(AMethod, AURL: String; ARequest, AResponse: TStream); | ||||
|   end; | ||||
| 
 | ||||
|   { TRestRequest } | ||||
| 
 | ||||
|   TRestRequest = class(TIdHTTPRequest) | ||||
|   public | ||||
|     procedure Prepare; | ||||
|   end; | ||||
| 
 | ||||
|   { TRestemplateApplication } | ||||
| 
 | ||||
|   TRestemplateApplication = class(TCustomApplication) | ||||
| @ -38,9 +52,10 @@ type | ||||
|     FSessionIni: TIniFile; | ||||
|     FTemplateName: String; | ||||
|     FParser: TJTemplateParser; | ||||
|     FHttp: TFPHTTPClient; | ||||
|     FHttp: TRestHTTP; | ||||
|     FRequest: TRestRequest; | ||||
|     FContent: TStringList; | ||||
|     FFormFields: TStringList; | ||||
|     FFormFields: TIdMultiPartFormDataStream; | ||||
|     FFilters: TFilterList; | ||||
|     FBeautify: Boolean; | ||||
|     FURL: String; | ||||
| @ -67,7 +82,8 @@ type | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   strutils, crt, UCRTHelper, fpjson, DOM, XMLRead, XMLWrite, vinfo; | ||||
|   strutils, crt, UCRTHelper, fpjson, DOM, XMLRead, XMLWrite, vinfo, | ||||
|   IdCompressorZLib; | ||||
| 
 | ||||
| type | ||||
|   TContentType = (ctOther, ctJSON, ctXML); | ||||
| @ -84,6 +100,22 @@ begin | ||||
|   Result := (ContentType <> ctOther); | ||||
| end; | ||||
| 
 | ||||
| { TRestRequest } | ||||
| 
 | ||||
| procedure TRestRequest.Prepare; | ||||
| begin | ||||
|   //Parse RawHeaders, since they have precendence and should not be overridden! | ||||
|   ProcessHeaders; | ||||
| end; | ||||
| 
 | ||||
| { TRestHTTP } | ||||
| 
 | ||||
| procedure TRestHTTP.Perform(AMethod, AURL: String; ARequest, AResponse: TStream | ||||
|   ); | ||||
| begin | ||||
|   DoRequest(AMethod, AURL, ARequest, AResponse, []); | ||||
| end; | ||||
| 
 | ||||
| { TRestemplateApplication } | ||||
| 
 | ||||
| procedure TRestemplateApplication.DoRun; | ||||
| @ -199,6 +231,11 @@ begin | ||||
|     Result := True; | ||||
|     CmdFormField(Copy(ALine, 11, Length(ALine))); | ||||
|   end else | ||||
|   if AnsiStartsStr('Compress', ALine) then | ||||
|   begin | ||||
|     Result := True; | ||||
|     FHttp.Compressor := TIdCompressorZLib.Create(FHttp); | ||||
|   end else | ||||
|   if AnsiStartsStr('Call ', ALine) then | ||||
|   begin | ||||
|     Result := True; | ||||
| @ -255,7 +292,11 @@ begin | ||||
|   varName := Trim(Copy(AHeader, 1, i - 1)); | ||||
|   varValue := Trim(Copy(AHeader, i + 1, Length(AHeader))); | ||||
| 
 | ||||
|   FHttp.AddHeader(varName, varValue); | ||||
|   //Special handling is required for Indy | ||||
|   {if SameText(varName, 'Accept-Encoding') then | ||||
|     FHttp.Request.AcceptEncoding := varValue | ||||
|   else} | ||||
|     FRequest.RawHeaders.AddValue(varName, varValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TRestemplateApplication.CmdBasicAuth(AData: String); | ||||
| @ -268,8 +309,9 @@ begin | ||||
|   while (i < Length(AData)) and (AData[i] <> separator) do | ||||
|     Inc(i); | ||||
| 
 | ||||
|   FHttp.UserName := Copy(AData, 2, i - 2); | ||||
|   FHttp.Password := Copy(AData, i + 1, Length(AData)); | ||||
|   FRequest.Username := Copy(AData, 2, i - 2); | ||||
|   FRequest.Password := Copy(AData, i + 1, Length(AData)); | ||||
|   FRequest.BasicAuthentication := True; | ||||
| end; | ||||
| 
 | ||||
| procedure TRestemplateApplication.CmdHighlight(AData: String); | ||||
| @ -278,10 +320,18 @@ begin | ||||
| end; | ||||
| 
 | ||||
| procedure TRestemplateApplication.CmdFormField(AData: String); | ||||
| var | ||||
|   i: Integer; | ||||
| begin | ||||
|   i := 1; | ||||
|   FParser.Content := AData; | ||||
|   FParser.Replace; | ||||
|   FFormFields.Add(FParser.Content); | ||||
|   AData := FParser.Content; | ||||
| 
 | ||||
|   while (i < Length(AData)) and (AData[i] <> '=') do | ||||
|     Inc(i); | ||||
| 
 | ||||
|   FFormFields.AddFormField(Copy(AData, 1, i - 1), Copy(AData, i + 1, Length(AData))); | ||||
| end; | ||||
| 
 | ||||
| procedure TRestemplateApplication.ProcessCall(AURL: String); | ||||
| @ -304,23 +354,24 @@ begin | ||||
|   if FContent.Count > 0 then | ||||
|   begin | ||||
|     request := TMemoryStream.Create; | ||||
| 
 | ||||
|     // Variable replacement | ||||
|     FParser.Content := FContent.Text; | ||||
|     FParser.Replace; | ||||
|     FContent.Text := FParser.Content; | ||||
| 
 | ||||
|     FContent.SaveToStream(request); | ||||
|     request.Position := 0; | ||||
|     FHttp.RequestBody := request; | ||||
|   end; | ||||
| 
 | ||||
|   try | ||||
|     //Special handling for formdata | ||||
|     if SameText('POST', FMethod) and (FFormFields.Count > 0) then | ||||
|       FHttp.FormPost(AURL, FFormFields, response) | ||||
|     else | ||||
|       FHttp.HTTPMethod(FMethod, AURL, response, []); | ||||
|     FRequest.Prepare; | ||||
|     FHttp.Request := FRequest; | ||||
|     FHttp.HTTPOptions := FHttp.HTTPOptions + [hoNoProtocolErrorException]; | ||||
|     if FFormFields.Size > 0 then | ||||
|     begin | ||||
|       FHttp.Request.ContentType := FFormFields.RequestContentType; | ||||
|       FHttp.Perform(FMethod, AURL, FFormFields, response); | ||||
|     end else | ||||
|       FHttp.Perform(FMethod, AURL, request, response); | ||||
|   except | ||||
|     on E: Exception do | ||||
|     begin | ||||
| @ -331,16 +382,16 @@ begin | ||||
|   end; | ||||
| 
 | ||||
|   writeln; | ||||
|   writeln('Status: ', FHttp.ResponseStatusCode, ' (', FHttp.ResponseStatusText, ')'); | ||||
|   writeln('Status: ', FHttp.ResponseCode, ' (', FHttp.ResponseText, ')'); | ||||
|   writeln; | ||||
|   writeln('Headers:'); | ||||
|   for s in FHttp.ResponseHeaders do | ||||
|   for s in FHttp.Response.RawHeaders do | ||||
|     writeln('  ', s); | ||||
|   writeln; | ||||
| 
 | ||||
|   response.Position := 0; | ||||
| 
 | ||||
|   if FBeautify and IdentifyContentType(FHttp.GetHeader(FHttp.ResponseHeaders, 'Content-Type'), contentType) then | ||||
|   if FBeautify and IdentifyContentType(FHttp.Response.ContentType, contentType) then | ||||
|   begin | ||||
|     case contentType of | ||||
|       ctJSON: | ||||
| @ -474,8 +525,10 @@ begin | ||||
| 
 | ||||
|   FSessionIni := TIniFile.Create(FConfigDir + 'session.ini'); | ||||
|   FContent := TStringList.Create; | ||||
|   FFormFields := TStringList.Create; | ||||
|   FHttp := TFPHTTPClient.Create(Self); | ||||
|   FFormFields := TIdMultiPartFormDataStream.Create; | ||||
|   FHttp := TRestHTTP.Create(nil); | ||||
|   FRequest := TRestRequest.Create(FHttp); | ||||
|   FRequest.RawHeaders.AddValue('User-Agent', 'Mozilla/4.0 (compatible; restemplate ' + VersionInfo.GetProductVersionString + ')'); | ||||
|   FFilters := TFilterList.Create; | ||||
|   FParser := TJTemplateParser.Create; | ||||
| end; | ||||
| @ -486,6 +539,7 @@ begin | ||||
|   FContent.Free; | ||||
|   FFormFields.Free; | ||||
|   FHttp.Free; | ||||
|   //TODO Owned? FRequest.Free; | ||||
|   FFilters.Free; | ||||
|   FParser.Free; | ||||
|   inherited Destroy; | ||||
|  | ||||
							
								
								
									
										
											BIN
										
									
								
								indy/Core/AboutBackground.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 546 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/AboutIndyNET.resources
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										
											BIN
										
									
								
								indy/Core/AboutProg.res
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdAntiFreeze.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdCmdTCPClient.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdCmdTCPServer.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdConnectionIntercept.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdICMPClient.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdIOHandlerStack.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdIOHandlerStream.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdIPMCastClient.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdIPMCastServer.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdInterceptSimLog.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdInterceptThrottler.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdLogDebug.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdLogEvent.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdLogFile.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdLogStream.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdSchedulerOfThreadDefault.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdSchedulerOfThreadPool.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdServerIOHandlerStack.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdSimpleServer.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdSocksInfo.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdTCPClient.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 822 B | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdTCPServer.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdThreadComponent.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdTraceRoute.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 822 B | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdUDPClient.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IconsDotNet/TIdUDPServer.bmp
									
									
									
									
									
										Normal file
									
								
							
							
						
						| After Width: | Height: | Size: 1.1 KiB | 
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdAbout.TWinForm.resources
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdAbout.TfrmAbout.resources
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										37
									
								
								indy/Core/IdAbout.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,37 @@ | ||||
| unit IdAbout; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF DOTNET} | ||||
|   IdAboutDotNET; | ||||
|   {$ELSE} | ||||
|   IdAboutVCL; | ||||
|   {$ENDIF} | ||||
| 
 | ||||
| //we have a procedure for providing a product name and version in case | ||||
| //we ever want to make another product. | ||||
| procedure ShowAboutBox(const AProductName, AProductName2, AProductVersion : String); | ||||
| procedure ShowDlg; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| {$IFDEF DOTNET} | ||||
|   //for some reason, the Winforms designer doesn't like this in the same unit | ||||
|   //as the class it's for | ||||
|   {$R 'IdAboutDotNET.TfrmAbout.resources' 'IdAboutDotNET.resx'} | ||||
| {$ENDIF} | ||||
| 
 | ||||
| procedure ShowAboutBox(const AProductName, AProductName2, AProductVersion : String); | ||||
| begin | ||||
|   TfrmAbout.ShowAboutBox(AProductName, AProductName2, AProductVersion); | ||||
| end; | ||||
| 
 | ||||
| procedure ShowDlg; | ||||
| begin | ||||
|   TfrmAbout.ShowDlg; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdAbout.resources
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										184
									
								
								indy/Core/IdAbout.resx
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,184 @@ | ||||
| <?xml version="1.0" encoding="utf-8"?> | ||||
| <root> | ||||
|   <!--  | ||||
|     Microsoft ResX Schema  | ||||
|      | ||||
|     Version 1.3 | ||||
|      | ||||
|     The primary goals of this format is to allow a simple XML format  | ||||
|     that is mostly human readable. The generation and parsing of the  | ||||
|     various data types are done through the TypeConverter classes  | ||||
|     associated with the data types. | ||||
|      | ||||
|     Example: | ||||
|      | ||||
|     ... ado.net/XML headers & schema ... | ||||
|     <resheader name="resmimetype">text/microsoft-resx</resheader> | ||||
|     <resheader name="version">1.3</resheader> | ||||
|     <resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader> | ||||
|     <resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader> | ||||
|     <data name="Name1">this is my long string</data> | ||||
|     <data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data> | ||||
|     <data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64"> | ||||
|         [base64 mime encoded serialized .NET Framework object] | ||||
|     </data> | ||||
|     <data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> | ||||
|         [base64 mime encoded string representing a byte array form of the .NET Framework object] | ||||
|     </data> | ||||
|                  | ||||
|     There are any number of "resheader" rows that contain simple  | ||||
|     name/value pairs. | ||||
|      | ||||
|     Each data row contains a name, and value. The row also contains a  | ||||
|     type or mimetype. Type corresponds to a .NET class that support  | ||||
|     text/value conversion through the TypeConverter architecture.  | ||||
|     Classes that don't support this are serialized and stored with the  | ||||
|     mimetype set. | ||||
|      | ||||
|     The mimetype is used forserialized objects, and tells the  | ||||
|     ResXResourceReader how to depersist the object. This is currently not  | ||||
|     extensible. For a given mimetype the value must be set accordingly: | ||||
|      | ||||
|     Note - application/x-microsoft.net.object.binary.base64 is the format  | ||||
|     that the ResXResourceWriter will generate, however the reader can  | ||||
|     read any of the formats listed below. | ||||
|      | ||||
|     mimetype: application/x-microsoft.net.object.binary.base64 | ||||
|     value   : The object must be serialized with  | ||||
|             : System.Serialization.Formatters.Binary.BinaryFormatter | ||||
|             : and then encoded with base64 encoding. | ||||
|      | ||||
|     mimetype: application/x-microsoft.net.object.soap.base64 | ||||
|     value   : The object must be serialized with  | ||||
|             : System.Runtime.Serialization.Formatters.Soap.SoapFormatter | ||||
|             : and then encoded with base64 encoding. | ||||
| 
 | ||||
|     mimetype: application/x-microsoft.net.object.bytearray.base64 | ||||
|     value   : The object must be serialized into a byte array  | ||||
|             : using a System.ComponentModel.TypeConverter | ||||
|             : and then encoded with base64 encoding. | ||||
|     --> | ||||
|   <xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata"> | ||||
|     <xsd:element name="root" msdata:IsDataSet="true"> | ||||
|       <xsd:complexType> | ||||
|         <xsd:choice maxOccurs="unbounded"> | ||||
|           <xsd:element name="data"> | ||||
|             <xsd:complexType> | ||||
|               <xsd:sequence> | ||||
|                 <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> | ||||
|                 <xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" /> | ||||
|               </xsd:sequence> | ||||
|               <xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" /> | ||||
|               <xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" /> | ||||
|               <xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" /> | ||||
|             </xsd:complexType> | ||||
|           </xsd:element> | ||||
|           <xsd:element name="resheader"> | ||||
|             <xsd:complexType> | ||||
|               <xsd:sequence> | ||||
|                 <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> | ||||
|               </xsd:sequence> | ||||
|               <xsd:attribute name="name" type="xsd:string" use="required" /> | ||||
|             </xsd:complexType> | ||||
|           </xsd:element> | ||||
|         </xsd:choice> | ||||
|       </xsd:complexType> | ||||
|     </xsd:element> | ||||
|   </xsd:schema> | ||||
|   <resheader name="resmimetype"> | ||||
|     <value>text/microsoft-resx</value> | ||||
|   </resheader> | ||||
|   <resheader name="version"> | ||||
|     <value>1.3</value> | ||||
|   </resheader> | ||||
|   <resheader name="reader"> | ||||
|     <value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> | ||||
|   </resheader> | ||||
|   <resheader name="writer"> | ||||
|     <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> | ||||
|   </resheader> | ||||
|   <data name="imgLogo.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="imgLogo.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblName.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblName.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblName2.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblName2.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblVersion.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblVersion.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblCopyright.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblCopyright.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblBuiltFor.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblBuiltFor.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblLicense.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblLicense.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblPleaseVisitUs.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblPleaseVisitUs.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblURL.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblURL.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="bbtnOk.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="bbtnOk.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="$this.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.Language" type="System.Globalization.CultureInfo, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>(Default)</value> | ||||
|   </data> | ||||
|   <data name="$this.TrayLargeIcon" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.Localizable" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.GridSize" type="System.Drawing.Size, System.Drawing, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> | ||||
|     <value>8, 8</value> | ||||
|   </data> | ||||
|   <data name="$this.DrawGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>True</value> | ||||
|   </data> | ||||
|   <data name="$this.TrayHeight" type="System.Int32, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>80</value> | ||||
|   </data> | ||||
|   <data name="$this.SnapToGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>True</value> | ||||
|   </data> | ||||
| </root> | ||||
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdAboutDotNET.TfrmAbout.resources
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										332
									
								
								indy/Core/IdAboutDotNET.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,332 @@ | ||||
| unit IdAboutDotNET; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| uses | ||||
|   System.Drawing, System.Collections, System.ComponentModel, | ||||
|   System.Windows.Forms, System.Data; | ||||
| 
 | ||||
| type | ||||
|   TfrmAbout = class(System.Windows.Forms.Form) | ||||
|   {$REGION 'Designer Managed Code'} | ||||
|   strict private | ||||
|     /// <summary> | ||||
|     /// Required designer variable. | ||||
|     /// </summary> | ||||
|     Components: System.ComponentModel.Container; | ||||
|     imgLogo: System.Windows.Forms.PictureBox; | ||||
|     bbtnOk: System.Windows.Forms.Button; | ||||
|     lblName: System.Windows.Forms.Label; | ||||
|     lblName2: System.Windows.Forms.Label; | ||||
|     lblVersion: System.Windows.Forms.Label; | ||||
|     lblCopyright: System.Windows.Forms.Label; | ||||
|     lblBuiltFor: System.Windows.Forms.Label; | ||||
|     lblLicense: System.Windows.Forms.Label; | ||||
|     lblPleaseVisitUs: System.Windows.Forms.Label; | ||||
|     lblURL: System.Windows.Forms.LinkLabel; | ||||
|     /// <summary> | ||||
|     /// Required method for Designer support - do not modify | ||||
|     /// the contents of this method with the code editor. | ||||
|     /// </summary> | ||||
|     procedure InitializeComponent; | ||||
|     procedure lblURL_LinkClicked(sender: System.Object; e: System.Windows.Forms.LinkLabelLinkClickedEventArgs); | ||||
|   {$ENDREGION} | ||||
|   strict protected | ||||
|     /// <summary> | ||||
|     /// Clean up any resources being used. | ||||
|     /// </summary> | ||||
|     procedure Dispose(Disposing: Boolean); override; | ||||
|   protected | ||||
|     { Private Declarations } | ||||
|     function GetProductName: string; | ||||
|     procedure SetProductName(const AValue: string); | ||||
|     function GetProductName2: string; | ||||
|     procedure SetProductName2(const AValue: string); | ||||
|     function GetVersion: string; | ||||
|     procedure SetVersion(const AValue: string); | ||||
|     function LoadBitmap(AResName: string): Bitmap; | ||||
|   public | ||||
|     constructor Create; | ||||
|     //we have a method for providing a product name and version in case | ||||
|     //we ever want to make another product. | ||||
|     class Procedure ShowAboutBox(const AProductName, AProductName2, AProductVersion : String); | ||||
|     class Procedure ShowDlg; | ||||
|    property ProductName : String read GetProductName write SetProductName; | ||||
|    property ProductName2 : String read GetProductName2 write SetProductName2; | ||||
|    property Version : String read GetVersion write SetVersion; | ||||
| 
 | ||||
|   end; | ||||
| 
 | ||||
|   [assembly: RuntimeRequiredAttribute(TypeOf(TfrmAbout))] | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdDsnCoreResourceStrings, System.Diagnostics, | ||||
|   IdGlobal, System.Reflection, System.Resources, SysUtils; | ||||
| 
 | ||||
| const | ||||
|   ResourceBaseName = 'IdAboutNET'; | ||||
| {$R 'AboutIndyNET.resources'} | ||||
| 
 | ||||
| {$AUTOBOX ON} | ||||
| 
 | ||||
| {$REGION 'Windows Form Designer generated code'} | ||||
| /// <summary> | ||||
| /// Required method for Designer support -- do not modify | ||||
| /// the contents of this method with the code editor. | ||||
| /// </summary> | ||||
| procedure TfrmAbout.InitializeComponent; | ||||
| begin | ||||
|   Self.imgLogo := System.Windows.Forms.PictureBox.Create; | ||||
|   Self.bbtnOk := System.Windows.Forms.Button.Create; | ||||
|   Self.lblName := System.Windows.Forms.Label.Create; | ||||
|   Self.lblName2 := System.Windows.Forms.Label.Create; | ||||
|   Self.lblVersion := System.Windows.Forms.Label.Create; | ||||
|   Self.lblCopyright := System.Windows.Forms.Label.Create; | ||||
|   Self.lblBuiltFor := System.Windows.Forms.Label.Create; | ||||
|   Self.lblLicense := System.Windows.Forms.Label.Create; | ||||
|   Self.lblPleaseVisitUs := System.Windows.Forms.Label.Create; | ||||
|   Self.lblURL := System.Windows.Forms.LinkLabel.Create; | ||||
|   Self.SuspendLayout; | ||||
|   // | ||||
|   // imgLogo | ||||
|   // | ||||
|   Self.imgLogo.Location := System.Drawing.Point.Create(0, 0); | ||||
|   Self.imgLogo.Name := 'imgLogo'; | ||||
|   Self.imgLogo.Size := System.Drawing.Size.Create(388, 240); | ||||
|   Self.imgLogo.TabIndex := 0; | ||||
|   Self.imgLogo.TabStop := False; | ||||
|   // | ||||
|   // bbtnOk | ||||
|   // | ||||
|   Self.bbtnOk.Anchor := (System.Windows.Forms.AnchorStyles((System.Windows.Forms.AnchorStyles.Bottom | ||||
|     or System.Windows.Forms.AnchorStyles.Right))); | ||||
|   Self.bbtnOk.DialogResult := System.Windows.Forms.DialogResult.Cancel; | ||||
|   Self.bbtnOk.Location := System.Drawing.Point.Create(475, 302); | ||||
|   Self.bbtnOk.Name := 'bbtnOk'; | ||||
|   Self.bbtnOk.TabIndex := 0; | ||||
|   Self.bbtnOk.Text := 'Button1'; | ||||
|   // | ||||
|   // lblName | ||||
|   // | ||||
|   Self.lblName.Font := System.Drawing.Font.Create('Arial Black', 14.25, System.Drawing.FontStyle.Regular, | ||||
|       System.Drawing.GraphicsUnit.Point, (Byte(0))); | ||||
|   Self.lblName.Location := System.Drawing.Point.Create(51, 28); | ||||
|   Self.lblName.Name := 'lblName'; | ||||
|   Self.lblName.Size := System.Drawing.Size.Create(200, 101); | ||||
|   Self.lblName.TabIndex := 1; | ||||
|   Self.lblName.Text := 'Label1'; | ||||
|   Self.lblName.TextAlign := System.Drawing.ContentAlignment.TopCenter; | ||||
|   // | ||||
|   // lblName2 | ||||
|   // | ||||
|   Self.lblName.Font := System.Drawing.Font.Create('Arial', 14.25, System.Drawing.FontStyle.Regular, | ||||
|       System.Drawing.GraphicsUnit.Point, (Byte(0))); | ||||
|   Self.lblName.Location := System.Drawing.Point.Create(54, 110); | ||||
|   Self.lblName.Name := 'lblName'; | ||||
|   Self.lblName.Size := System.Drawing.Size.Create(192, 35); | ||||
|   Self.lblName.TabIndex := 2; | ||||
|   Self.lblName.Text := 'Label2'; | ||||
|   Self.lblName.TextAlign := System.Drawing.ContentAlignment.TopCenter; | ||||
|   // | ||||
|   // lblVersion | ||||
|   // | ||||
|   Self.lblVersion.Font := System.Drawing.Font.Create('Arial', 14.25, | ||||
|       System.Drawing.FontStyle.Bold, System.Drawing.GraphicsUnit.Point, (Byte(0))); | ||||
|   Self.lblVersion.Location := System.Drawing.Point.Create(300, 170); | ||||
|   Self.lblVersion.Name := 'lblVersion'; | ||||
|   Self.lblVersion.Size := System.Drawing.Size.Create(200, 17); | ||||
|   Self.lblVersion.TabIndex := 3; | ||||
|   Self.lblVersion.Text := 'Label3'; | ||||
|   Self.lblVersion.TextAlign := System.Drawing.ContentAlignment.TopRight; | ||||
|   // | ||||
|   // lblCopyright | ||||
|   // | ||||
|   Self.lblCopyright.Font := System.Drawing.Font.Create('Arial', 14.25, | ||||
|       System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, (Byte(0))); | ||||
|   Self.lblCopyright.Location := System.Drawing.Point.Create(58, 171); | ||||
|   Self.lblCopyright.Name := 'lblCopyright'; | ||||
|   Self.lblCopyright.Size := System.Drawing.Size.Create(138, 15); | ||||
|   Self.lblCopyright.TabIndex := 6; | ||||
|   Self.lblCopyright.Text := 'Label6'; | ||||
|   Self.lblCopyright.TextAlign := System.Drawing.ContentAlignment.TopCenter; | ||||
|   // | ||||
|   // lblBuiltFor | ||||
|   // | ||||
|   Self.lblBuiltFor.Anchor := (System.Windows.Forms.AnchorStyles(((System.Windows.Forms.AnchorStyles.Top | ||||
|     or System.Windows.Forms.AnchorStyles.Right))); | ||||
|   Self.lblBuiltFor.Font := System.Drawing.Font.Create('Arial', 14.25, | ||||
|       System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, (Byte(0))); | ||||
|   Self.lblBuiltFor.Location := System.Drawing.Point.Create(300, 188); | ||||
|   Self.lblBuiltFor.Name := 'lblBuiltFor'; | ||||
|   Self.lblBuiltFor.Size := System.Drawing.Size.Create(200, 17); | ||||
|   Self.lblBuiltFor.TabIndex := 4; | ||||
|   Self.lblBuiltFor.Text := 'Label4'; | ||||
|   Self.lblBuiltFor.TextAlign := System.Drawing.ContentAlignment.TopRight; | ||||
|   // | ||||
|   // lblLicense | ||||
|   // | ||||
|   Self.lblLicense.Anchor := (System.Windows.Forms.AnchorStyles(((System.Windows.Forms.AnchorStyles.Top | ||||
|     or System.Windows.Forms.AnchorStyles.Right))); | ||||
|   Self.lblLicense.Font := System.Drawing.Font.Create('Arial', 14.25, | ||||
|       System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, (Byte(0))); | ||||
|   Self.lblLicense.Location := System.Drawing.Point.Create(300, 227); | ||||
|   Self.lblLicense.Name := 'lblLicense'; | ||||
|   Self.lblLicense.Size := System.Drawing.Size.Create(200, 45); | ||||
|   Self.lblLicense.TabIndex := 5; | ||||
|   Self.lblLicense.Text := 'Label5'; | ||||
|   Self.lblBuiltFor.TextAlign := System.Drawing.ContentAlignment.TopRight; | ||||
|   // | ||||
|   // lblPleaseVisitUs | ||||
|   // | ||||
|   Self.lblPleaseVisitUs.Font := System.Drawing.Font.Create('Arial', 14.25, | ||||
|       System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, (Byte(0))); | ||||
|   Self.lblPleaseVisitUs.Location := System.Drawing.Point.Create(58, 278); | ||||
|   Self.lblPleaseVisitUs.Name := 'lblPleaseVisitUs'; | ||||
|   Self.lblPleaseVisitUs.Size := System.Drawing.Size.Create(276, 15); | ||||
|   Self.lblPleaseVisitUs.TabIndex := 7; | ||||
|   Self.lblPleaseVisitUs.Text := 'Label7'; | ||||
|   Self.lblPleaseVisitUs.TextAlign := System.Drawing.ContentAlignment.TopCenter; | ||||
|   // | ||||
|   // lblURL | ||||
|   // | ||||
|   Self.lblCopyright.Font := System.Drawing.Font.Create('Arial', 14.25, | ||||
|       System.Drawing.FontStyle.Regular, System.Drawing.GraphicsUnit.Point, (Byte(0))); | ||||
|   Self.lblURL.Location := System.Drawing.Point.Create(58, 292); | ||||
|   Self.lblURL.Name := 'lblURL'; | ||||
|   Self.lblURL.Size := System.Drawing.Size.Create(141, 15); | ||||
|   Self.lblURL.TabIndex := 8; | ||||
|   Self.lblURL.TabStop := True; | ||||
|   Self.lblURL.Text := 'LinkLabel8'; | ||||
|   Self.lblURL.TextAlign := System.Drawing.ContentAlignment.TopCenter; | ||||
|   Include(Self.lblURL.LinkClicked, Self.lblURL_LinkClicked); | ||||
|   // | ||||
|   // TfrmAbout | ||||
|   // | ||||
|   Self.AcceptButton := Self.bbtnOk; | ||||
|   Self.AutoScaleBaseSize := System.Drawing.Size.Create(5, 13); | ||||
|   Self.CancelButton := Self.bbtnOk; | ||||
|   Self.ClientSize := System.Drawing.Size.Create(336, 554); | ||||
|   Self.Controls.Add(Self.lblURL); | ||||
|   Self.Controls.Add(Self.lblPleaseVisitUs); | ||||
|   Self.Controls.Add(Self.lblCopyright); | ||||
|   Self.Controls.Add(Self.lblVersion); | ||||
|   Self.Controls.Add(Self.lblName); | ||||
|   Self.Controls.Add(Self.lblName2); | ||||
|   Self.Controls.Add(Self.lblBuiltFor); | ||||
|   Self.Controls.Add(Self.lblLicense); | ||||
|   Self.Controls.Add(Self.bbtnOk); | ||||
|   Self.Controls.Add(Self.imgLogo); | ||||
|   Self.FormBorderStyle := System.Windows.Forms.FormBorderStyle.FixedDialog; | ||||
|   Self.MaximizeBox := False; | ||||
|   Self.MinimizeBox := False; | ||||
|   Self.Name := 'TfrmAbout'; | ||||
|   Self.ShowInTaskbar := False; | ||||
|   Self.StartPosition := System.Windows.Forms.FormStartPosition.CenterScreen; | ||||
|   Self.Text := 'WinForm'; | ||||
|   Self.ResumeLayout(False); | ||||
| end; | ||||
| {$ENDREGION} | ||||
| 
 | ||||
| procedure TfrmAbout.Dispose(Disposing: Boolean); | ||||
| begin | ||||
|   if Disposing then | ||||
|   begin | ||||
|     if Components <> nil then | ||||
|       Components.Dispose(); | ||||
|   end; | ||||
|   inherited Dispose(Disposing); | ||||
| end; | ||||
| 
 | ||||
| constructor TfrmAbout.Create; | ||||
| begin | ||||
|   inherited Create; | ||||
|   // | ||||
|   // Required for Windows Form Designer support | ||||
|   // | ||||
|   InitializeComponent; | ||||
|   // | ||||
|   // TODO: Add any constructor code after InitializeComponent call | ||||
|   // | ||||
|   Self.Text := RSAAboutFormCaption; | ||||
|   lblName.Text := RSAAboutBoxTitle1; | ||||
|   lblName2.Text := RSAAboutBoxTitle2; | ||||
|   lblBuiltFor.Text := IndyFormat(RSAAboutBoxBuiltFor, ['DotNET']); | ||||
|   lblLicense.Text := RSAAboutBoxLicences; | ||||
|   lblCopyright.Text := RSAAboutBoxCopyright; | ||||
|   lblPleaseVisitUs.Text := RSAAboutBoxPleaseVisit; | ||||
|   lblURL.Text := RSAAboutBoxIndyWebsite; | ||||
|   lblURL.Links.Add(0, Length(RSAABoutBoxIndyWebsite), RSAAboutBoxIndyWebsite); | ||||
|   bbtnOk.Text := RSOk; | ||||
|   imgLogo.Image := LoadBitmap('AboutBackground.bmp'); | ||||
| end; | ||||
| 
 | ||||
| procedure TfrmAbout.SetProductName(const AValue : String); | ||||
| begin | ||||
|   Self.lblName.Text := AValue; | ||||
| end; | ||||
| 
 | ||||
| procedure TfrmAbout.SetProductName2(const AValue : String); | ||||
| begin | ||||
|   Self.lblName2.Text := AValue; | ||||
| end; | ||||
| 
 | ||||
| procedure TfrmAbout.SetVersion(const AValue: string); | ||||
| begin | ||||
|   Self.lblVersion.Text := AValue; | ||||
| end; | ||||
| 
 | ||||
| function TfrmAbout.GetVersion: string; | ||||
| begin | ||||
|   Result := Self.lblVersion.Text; | ||||
| end; | ||||
| 
 | ||||
| function TfrmAbout.GetProductName: string; | ||||
| begin | ||||
|   Result := Self.lblName.Text; | ||||
| end; | ||||
| 
 | ||||
| function TfrmAbout.GetProductName2: string; | ||||
| begin | ||||
|   Result := Self.lblName2.Text; | ||||
| end; | ||||
| 
 | ||||
| class procedure TfrmAbout.ShowAboutBox(const AProductName, AProductName2, | ||||
|   AProductVersion: String); | ||||
| begin | ||||
|   with TfrmAbout.Create do | ||||
|   try | ||||
|     Version := IndyFormat(RSAAboutBoxVersion, [AProductVersion]); | ||||
|     ProductName := AProductName; | ||||
|     ProductName2 := AProductName2; | ||||
|     Text := AProductName; | ||||
|     ShowDialog; | ||||
|   finally | ||||
|     Dispose; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| class procedure TfrmAbout.ShowDlg; | ||||
| begin | ||||
|   ShowAboutBox(RSAAboutBoxTitle1, RSAAboutBoxTitle2, gsIdVersion); | ||||
| end; | ||||
| 
 | ||||
| procedure TfrmAbout.lblURL_LinkClicked(sender: System.Object; e: System.Windows.Forms.LinkLabelLinkClickedEventArgs); | ||||
| var | ||||
|   LDest : String; | ||||
| begin | ||||
|   LDest := e.Link.LinkData as string; | ||||
|   System.Diagnostics.Process.Start(LDest); | ||||
|   e.Link.Visited := True; | ||||
| end; | ||||
| 
 | ||||
| function TfrmAbout.LoadBitmap(AResName: string): Bitmap; | ||||
| var | ||||
|   LR: System.Resources.ResourceManager; | ||||
| begin | ||||
|   LR := System.Resources.ResourceManager.Create('AboutIndyNET', System.Reflection.Assembly.GetExecutingAssembly); | ||||
|   Result := (Bitmap(LR.GetObject(AResName))); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdAboutDotNET.resources
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										184
									
								
								indy/Core/IdAboutDotNET.resx
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,184 @@ | ||||
| <?xml version="1.0" encoding="utf-8"?> | ||||
| <root> | ||||
|   <!--  | ||||
|     Microsoft ResX Schema  | ||||
|      | ||||
|     Version 1.3 | ||||
|      | ||||
|     The primary goals of this format is to allow a simple XML format  | ||||
|     that is mostly human readable. The generation and parsing of the  | ||||
|     various data types are done through the TypeConverter classes  | ||||
|     associated with the data types. | ||||
|      | ||||
|     Example: | ||||
|      | ||||
|     ... ado.net/XML headers & schema ... | ||||
|     <resheader name="resmimetype">text/microsoft-resx</resheader> | ||||
|     <resheader name="version">1.3</resheader> | ||||
|     <resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader> | ||||
|     <resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader> | ||||
|     <data name="Name1">this is my long string</data> | ||||
|     <data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data> | ||||
|     <data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64"> | ||||
|         [base64 mime encoded serialized .NET Framework object] | ||||
|     </data> | ||||
|     <data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> | ||||
|         [base64 mime encoded string representing a byte array form of the .NET Framework object] | ||||
|     </data> | ||||
|                  | ||||
|     There are any number of "resheader" rows that contain simple  | ||||
|     name/value pairs. | ||||
|      | ||||
|     Each data row contains a name, and value. The row also contains a  | ||||
|     type or mimetype. Type corresponds to a .NET class that support  | ||||
|     text/value conversion through the TypeConverter architecture.  | ||||
|     Classes that don't support this are serialized and stored with the  | ||||
|     mimetype set. | ||||
|      | ||||
|     The mimetype is used forserialized objects, and tells the  | ||||
|     ResXResourceReader how to depersist the object. This is currently not  | ||||
|     extensible. For a given mimetype the value must be set accordingly: | ||||
|      | ||||
|     Note - application/x-microsoft.net.object.binary.base64 is the format  | ||||
|     that the ResXResourceWriter will generate, however the reader can  | ||||
|     read any of the formats listed below. | ||||
|      | ||||
|     mimetype: application/x-microsoft.net.object.binary.base64 | ||||
|     value   : The object must be serialized with  | ||||
|             : System.Serialization.Formatters.Binary.BinaryFormatter | ||||
|             : and then encoded with base64 encoding. | ||||
|      | ||||
|     mimetype: application/x-microsoft.net.object.soap.base64 | ||||
|     value   : The object must be serialized with  | ||||
|             : System.Runtime.Serialization.Formatters.Soap.SoapFormatter | ||||
|             : and then encoded with base64 encoding. | ||||
| 
 | ||||
|     mimetype: application/x-microsoft.net.object.bytearray.base64 | ||||
|     value   : The object must be serialized into a byte array  | ||||
|             : using a System.ComponentModel.TypeConverter | ||||
|             : and then encoded with base64 encoding. | ||||
|     --> | ||||
|   <xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata"> | ||||
|     <xsd:element name="root" msdata:IsDataSet="true"> | ||||
|       <xsd:complexType> | ||||
|         <xsd:choice maxOccurs="unbounded"> | ||||
|           <xsd:element name="data"> | ||||
|             <xsd:complexType> | ||||
|               <xsd:sequence> | ||||
|                 <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> | ||||
|                 <xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" /> | ||||
|               </xsd:sequence> | ||||
|               <xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" /> | ||||
|               <xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" /> | ||||
|               <xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" /> | ||||
|             </xsd:complexType> | ||||
|           </xsd:element> | ||||
|           <xsd:element name="resheader"> | ||||
|             <xsd:complexType> | ||||
|               <xsd:sequence> | ||||
|                 <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> | ||||
|               </xsd:sequence> | ||||
|               <xsd:attribute name="name" type="xsd:string" use="required" /> | ||||
|             </xsd:complexType> | ||||
|           </xsd:element> | ||||
|         </xsd:choice> | ||||
|       </xsd:complexType> | ||||
|     </xsd:element> | ||||
|   </xsd:schema> | ||||
|   <resheader name="resmimetype"> | ||||
|     <value>text/microsoft-resx</value> | ||||
|   </resheader> | ||||
|   <resheader name="version"> | ||||
|     <value>1.3</value> | ||||
|   </resheader> | ||||
|   <resheader name="reader"> | ||||
|     <value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> | ||||
|   </resheader> | ||||
|   <resheader name="writer"> | ||||
|     <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> | ||||
|   </resheader> | ||||
|   <data name="imgLogo.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="imgLogo.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="bbtnOk.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="bbtnOk.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblName.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblName.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblName2.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblName2.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblVersion.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblVersion.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblCopyright.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblCopyright.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblBuiltFor.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblBuiltFor.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblLicense.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblLicense.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblPleaseVisitUs.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblPleaseVisitUs.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblURL.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblURL.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.Language" type="System.Globalization.CultureInfo, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>(Default)</value> | ||||
|   </data> | ||||
|   <data name="$this.TrayLargeIcon" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.Localizable" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.GridSize" type="System.Drawing.Size, System.Drawing, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> | ||||
|     <value>8, 8</value> | ||||
|   </data> | ||||
|   <data name="$this.DrawGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>True</value> | ||||
|   </data> | ||||
|   <data name="$this.TrayHeight" type="System.Int32, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>80</value> | ||||
|   </data> | ||||
|   <data name="$this.SnapToGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>True</value> | ||||
|   </data> | ||||
| </root> | ||||
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdAboutNET.resources
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdAboutVCL.RES
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										5438
									
								
								indy/Core/IdAboutVCL.lrs
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										420
									
								
								indy/Core/IdAboutVCL.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,420 @@ | ||||
| unit IdAboutVCL; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
| {$IFDEF WIDGET_KYLIX} | ||||
|   QStdCtrls, QForms, QExtCtrls, QControls, QComCtrls, QGraphics, Qt, | ||||
| {$ENDIF} | ||||
| {$IFDEF WIDGET_VCL_LIKE} | ||||
|   StdCtrls, Buttons, ExtCtrls, Graphics, Controls, ComCtrls, Forms, | ||||
| {$ENDIF} | ||||
| {$IFDEF HAS_UNIT_Types} | ||||
|   Types, | ||||
| {$ENDIF} | ||||
| {$IFDEF WIDGET_LCL} | ||||
|   LResources, | ||||
| {$ENDIF} | ||||
|   Classes, SysUtils; | ||||
| 
 | ||||
| type | ||||
|   TfrmAbout = class(TForm) | ||||
|   protected | ||||
|     FimLogo : TImage; | ||||
|     FlblCopyRight : TLabel; | ||||
|     FlblName : TLabel; | ||||
|     FlblName2 : TLabel; | ||||
|     FlblVersion : TLabel; | ||||
|     FlblBuiltFor : TLabel; | ||||
|     FlblLicense : TLabel; | ||||
|     FlblPleaseVisitUs : TLabel; | ||||
|     FlblURL : TLabel; | ||||
|     //for LCL, we use a TBitBtn to be consistant with some GUI interfaces | ||||
|     //and the Lazarus IDE. | ||||
|     {$IFDEF USE_TBitBtn} | ||||
|     FbbtnOk : TBitBtn; | ||||
|     {$ELSE} | ||||
|     FbbtnOk : TButton; | ||||
|     {$ENDIF} | ||||
|     procedure lblURLClick(Sender: TObject); | ||||
|     function GetProductName: String; | ||||
|     procedure SetProductName(const AValue: String); | ||||
|     function GetProductName2: String; | ||||
|     procedure SetProductName2(const AValue: String); | ||||
|     function GetVersion: String; | ||||
|     procedure SetVersion(const AValue: String); | ||||
|   public | ||||
|     //we have a method for providing a product name and version in case | ||||
|     //we ever want to make another product. | ||||
|     class procedure ShowDlg; | ||||
|     class procedure ShowAboutBox(const AProductName, AProductName2, AProductVersion: String); | ||||
|     constructor Create(AOwner : TComponent); overload; override; | ||||
|     constructor Create; reintroduce; overload; | ||||
|     property ProductName : String read GetProductName write SetProductName; | ||||
|     property ProductName2 : String read GetProductName2 write SetProductName2; | ||||
|     property Version : String read GetVersion write SetVersion; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| {$IFNDEF WIDGET_LCL} | ||||
|   {$IFDEF WIN32_OR_WIN64} | ||||
|   {$R IdAboutVCL.RES} | ||||
|   {$ENDIF} | ||||
|   {$IFDEF KYLIX} | ||||
|   {$R IdAboutVCL.RES} | ||||
|   {$ENDIF} | ||||
| {$ENDIF} | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF WIN32_OR_WIN64}ShellApi, {$ENDIF} | ||||
|   {$IFNDEF WIDGET_LCL} | ||||
|    //done this way because we reference HInstance in Delphi for loading | ||||
|    //resources.  Lazarus does something different. | ||||
|     {$IFDEF WIN32_OR_WIN64} | ||||
|   Windows, | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   IdDsnCoreResourceStrings, | ||||
|   IdGlobal; | ||||
| 
 | ||||
| {$IFNDEF WIDGET_LCL} | ||||
| function RGBToColor(R, G, B: Byte): TColor; | ||||
| begin | ||||
|   Result := RGB(R, G, B); | ||||
| end; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| { TfrmAbout } | ||||
| 
 | ||||
| constructor TfrmAbout.Create(AOwner: TComponent); | ||||
| begin | ||||
|   inherited CreateNew(AOwner,0); | ||||
| 
 | ||||
|   FimLogo := TImage.Create(Self); | ||||
|   FlblCopyRight := TLabel.Create(Self); | ||||
|   FlblName := TLabel.Create(Self); | ||||
|   FlblName2 := TLabel.Create(Self); | ||||
|   FlblVersion := TLabel.Create(Self); | ||||
|   FlblBuiltFor := TLabel.Create(Self); | ||||
|   FlblLicense := TLabel.Create(Self); | ||||
|   FlblPleaseVisitUs := TLabel.Create(Self); | ||||
|   FlblURL := TLabel.Create(Self); | ||||
|   {$IFDEF USE_TBitBtn} | ||||
|   FbbtnOk := TBitBtn.Create(Self); | ||||
|   {$ELSE} | ||||
|   FbbtnOk := TButton.Create(Self); | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   Name := 'formAbout'; | ||||
|   Left := 0; | ||||
|   Top := 0; | ||||
|   Anchors := [];//[akLeft, akTop, akRight,akBottom]; | ||||
|   BorderIcons := [biSystemMenu]; | ||||
|   BorderStyle := bsDialog; | ||||
| 
 | ||||
|   Caption := RSAAboutFormCaption; | ||||
|   ClientHeight := 336; | ||||
|   ClientWidth := 554; | ||||
|   Color := 2520226; // RGBToColor(38, 116, 162) | ||||
| 
 | ||||
|   Font.Color := 16776138; // RGBToColor(202, 251, 255) | ||||
|   Font.Height := -12; | ||||
|   Font.Size := 9; | ||||
|   Font.Name := 'Arial'; | ||||
|   Font.Style := []; | ||||
|   Position := poScreenCenter; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   Scaled := True; | ||||
|   {$ENDIF} | ||||
|   Constraints.MinHeight := Height; | ||||
|   Constraints.MinWidth := Width; | ||||
|   //  PixelsPerInch := 96; | ||||
| 
 | ||||
|   FimLogo.Name := 'imLogo'; | ||||
|   FimLogo.Parent := Self; | ||||
|   FimLogo.Left := 0; | ||||
|   FimLogo.Top := 0; | ||||
|   FimLogo.Width := 388; | ||||
|   FimLogo.Height := 240; | ||||
| 
 | ||||
|   {$IFDEF WIDGET_LCL} | ||||
|   FimLogo.Picture.Pixmap.LoadFromLazarusResource('IndyAboutBkgnd'); //this is XPM format, so Pixmap is used | ||||
|   FimLogo.Align := alClient; | ||||
|   FimLogo.Stretch := True; | ||||
|   {$ELSE} // Because Lazarus is also WIDGET_VCL_LIKE_OR_KYLIX | ||||
|     {$IFDEF WIDGET_VCL_LIKE_OR_KYLIX} | ||||
|   FimLogo.Picture.Bitmap.LoadFromResourceName(HInstance, 'INDY_ABOUT_BACKGROUND');    {Do not Localize} | ||||
|   FimLogo.Align := alClient; | ||||
|   FimLogo.Stretch := True; | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   FlblName.Name := 'lblName'; | ||||
|   FlblName.Parent := Self; | ||||
|   FlblName.Left := 51; | ||||
|   FlblName.Top := 28; | ||||
|   FlblName.Width := 200; | ||||
|   FlblName.Height := 101; | ||||
|   FlblName.Anchors := [akLeft, akTop]; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   FlblName.Font.Charset := DEFAULT_CHARSET; | ||||
|   FlblName.Transparent := True; | ||||
|   {$ENDIF} | ||||
|   FlblName.Font.Color := clWhite; | ||||
|   FlblName.Font.Height := -72; | ||||
|   FlblName.Font.Name := 'Arial Black'; | ||||
|   FlblName.Font.Style := []; | ||||
|   FlblName.ParentFont := False; | ||||
|   FlblName.WordWrap := False; | ||||
|   FlblName.Caption := RSAAboutBoxTitle1; | ||||
| 
 | ||||
|   FlblName2.Name := 'lblName2'; | ||||
|   FlblName2.Parent := Self; | ||||
|   FlblName2.Left := 54; | ||||
|   FlblName2.Top := 110; | ||||
|   FlblName2.Width := 192; | ||||
|   FlblName2.Height := 35; | ||||
|   FlblName2.Anchors := [akLeft, akTop]; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   FlblName2.Font.Charset := DEFAULT_CHARSET; | ||||
|   FlblName2.Transparent := True; | ||||
|   {$ENDIF} | ||||
|   FlblName2.Font.Color := clWhite; | ||||
|   FlblName2.Font.Height := -31; | ||||
|   FlblName2.Font.Name := 'Arial'; | ||||
|   FlblName2.Font.Style := []; | ||||
|   FlblName2.ParentFont := False; | ||||
|   FlblName2.WordWrap := False; | ||||
|   FlblName2.Caption := RSAAboutBoxTitle2; | ||||
| 
 | ||||
|   FlblVersion.Name := 'lblVersion'; | ||||
|   FlblVersion.Parent := Self; | ||||
|   FlblVersion.Left := 300; | ||||
|   FlblVersion.Top := 170; | ||||
|   FlblVersion.Width := 200; | ||||
|   FlblVersion.Height := 17; | ||||
|   FlblVersion.Alignment := taRightJustify; | ||||
|   FlblVersion.AutoSize := False; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   FlblVersion.Font.Charset := DEFAULT_CHARSET; | ||||
|   FlblVersion.Transparent := True; | ||||
|   {$ENDIF} | ||||
|   FlblVersion.Font.Color := 16776138; // RGBToColor(202, 251, 255) | ||||
|   FlblVersion.Font.Height := -15; | ||||
|   FlblVersion.Font.Name := 'Arial'; | ||||
|   FlblVersion.Font.Style := [fsBold]; | ||||
|   FlblVersion.ParentFont := False; | ||||
|   FlblVersion.Anchors := [akTop, akRight]; | ||||
| 
 | ||||
|   FlblBuiltFor.Name := 'lblBuiltFor'; | ||||
|   FlblBuiltFor.Parent := Self; | ||||
|   FlblBuiltFor.Left := 300; | ||||
|   FlblBuiltFor.Top := 188; | ||||
|   FlblBuiltFor.Width := 200; | ||||
|   FlblBuiltFor.Height := 17; | ||||
|   FlblBuiltFor.Alignment := taRightJustify; | ||||
|   FlblBuiltFor.AutoSize := False; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   FlblBuiltFor.Font.Charset := DEFAULT_CHARSET; | ||||
|   FlblBuiltFor.Transparent := True; | ||||
|   {$ENDIF} | ||||
|   FlblBuiltFor.Font.Color := 16776138; // RGBToColor(202, 251, 255) | ||||
|   FlblBuiltFor.Font.Height := -14; | ||||
|   FlblBuiltFor.Font.Name := 'Arial'; | ||||
|   FlblBuiltFor.Font.Style := []; | ||||
|   FlblBuiltFor.ParentFont := False; | ||||
|   FlblBuiltFor.Anchors := [akTop, akRight]; | ||||
| 
 | ||||
|   // RLebeau: not using resouce strings for the product names because: | ||||
|   // 1. the names are pretty specific and not likely to change with localization; | ||||
|   // 2. we are trying to avoid using IFDEFs in resource units, per Embarcadero's request; | ||||
|   // 3. I don't want to create more product-specific resource units unless we really need them; | ||||
|   {$IFDEF WIDGET_KYLIX} | ||||
|   FlblBuiltFor.Caption := IndyFormat(RSAAboutBoxBuiltFor, ['Kylix']); | ||||
|   {$ELSE} | ||||
|     {$IFDEF WIDGET_VCL} | ||||
|   FlblBuiltFor.Caption := IndyFormat(RSAAboutBoxBuiltFor, ['VCL']); | ||||
|     {$ELSE} | ||||
|       {$IFDEF WIDGET_LCL} | ||||
|   FlblBuiltFor.Caption := IndyFormat(RSAAboutBoxBuiltFor, ['Lazarus']); | ||||
|       {$ELSE} | ||||
|   FlblBuiltFor.Caption := IndyFormat(RSAAboutBoxBuiltFor, ['Unknown']); | ||||
|       {$ENDIF} | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   FlblLicense.Name := 'lblLicense'; | ||||
|   FlblLicense.Parent := Self; | ||||
|   FlblLicense.Left := 300; | ||||
|   FlblLicense.Top := 227; | ||||
|   FlblLicense.Width := 200; | ||||
|   FlblLicense.Height := 45; | ||||
|   FlblLicense.Alignment := taRightJustify; | ||||
|   FlblLicense.AutoSize := False; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   FlblLicense.Font.Charset := DEFAULT_CHARSET; | ||||
|   FlblLicense.Transparent := True; | ||||
|   {$ENDIF} | ||||
|   FlblLicense.Font.Color := 16776138; // RGBToColor(202, 251, 255) | ||||
|   FlblLicense.Font.Height := -12; | ||||
|   FlblLicense.Font.Name := 'Arial'; | ||||
|   FlblLicense.Font.Style := []; | ||||
|   FlblLicense.ParentFont := False; | ||||
|   FlblLicense.WordWrap := True; | ||||
|   FlblLicense.Anchors := [akTop, akRight]; | ||||
|   FlblLicense.Caption := RSAAboutBoxLicences; | ||||
| 
 | ||||
|   FlblCopyRight.Name := 'lblCopyRight'; | ||||
|   FlblCopyRight.Parent := Self; | ||||
|   FlblCopyRight.Left := 58; | ||||
|   FlblCopyRight.Top := 171; | ||||
|   FlblCopyRight.Width := 138; | ||||
|   FlblCopyRight.Height := 15; | ||||
|   FlblCopyRight.Caption := RSAAboutBoxCopyright; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   FlblCopyRight.Font.Charset := DEFAULT_CHARSET; | ||||
|   FlblCopyRight.Transparent := True; | ||||
|   {$ENDIF} | ||||
|   FlblCopyRight.Font.Color := 16776138; // RGBToColor(202, 251, 255) | ||||
|   FlblCopyRight.Font.Height := -12; | ||||
|   FlblCopyRight.Font.Name := 'Arial'; | ||||
|   FlblCopyRight.Font.Style := []; | ||||
|   FlblCopyRight.ParentFont := False; | ||||
|   FlblCopyRight.WordWrap := True; | ||||
| 
 | ||||
|   FlblPleaseVisitUs.Name := 'lblPleaseVisitUs'; | ||||
|   FlblPleaseVisitUs.Parent := Self; | ||||
|   FlblPleaseVisitUs.Left := 58; | ||||
|   FlblPleaseVisitUs.Top := 278; | ||||
|   FlblPleaseVisitUs.Width := 276; | ||||
|   FlblPleaseVisitUs.Height := 15; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   FlblPleaseVisitUs.Font.Charset := DEFAULT_CHARSET; | ||||
|   FlblPleaseVisitUs.Transparent := True; | ||||
|   {$ENDIF} | ||||
|   FlblPleaseVisitUs.Font.Color := 16776138; // RGBToColor(202, 251, 255) | ||||
|   FlblPleaseVisitUs.Font.Height := -12; | ||||
|   FlblPleaseVisitUs.Font.Name := 'Arial'; | ||||
|   FlblPleaseVisitUs.ParentFont := False; | ||||
|   FlblPleaseVisitUs.Caption := RSAAboutBoxPleaseVisit; | ||||
|   FlblPleaseVisitUs.Anchors := [akLeft, akTop]; | ||||
| 
 | ||||
|   FlblURL.Name := 'lblURL'; | ||||
|   FlblURL.Left := 58; | ||||
|   FlblURL.Top := 292; | ||||
|   FlblURL.Width := 141; | ||||
|   FlblURL.Height := 15; | ||||
|   FlblURL.Cursor := crHandPoint; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   FlblURL.Font.Charset := DEFAULT_CHARSET; | ||||
|   FlblURL.Transparent := True; | ||||
|   {$ENDIF} | ||||
|   FlblURL.Font.Color := 16776138; // RGBToColor(202, 251, 255) | ||||
|   FlblURL.Font.Height := -12; | ||||
|   FlblURL.Font.Name := 'Arial'; | ||||
|   FlblURL.ParentFont := False; | ||||
|   FlblURL.OnClick := lblURLClick; | ||||
|   FlblURL.Caption := RSAAboutBoxIndyWebsite; | ||||
|   FlblURL.Anchors := [akLeft, akTop]; | ||||
|   FlblURL.Parent := Self; | ||||
| 
 | ||||
|   FbbtnOk.Name := 'bbtnOk'; | ||||
|   FbbtnOk.Left := 475; | ||||
|   {$IFDEF USE_TBitBtn} | ||||
|   FbbtnOk.Top := 297; | ||||
|   {$ELSE} | ||||
|   FbbtnOk.Top := 302; | ||||
|   FbbtnOk.Height := 25; | ||||
|   {$ENDIF} | ||||
|   FbbtnOk.Width := 75; | ||||
|   FbbtnOk.Anchors := [akRight, akBottom]; | ||||
|   {$IFDEF USE_TBitBtn} | ||||
|   FbbtnOk.Font.Color := clBlack; | ||||
|   FbbtnOk.ParentFont := False; | ||||
|   FbbtnOk.Kind := bkOk; | ||||
|   {$ELSE} | ||||
|   FbbtnOk.Caption := RSOk; | ||||
|   {$ENDIF} | ||||
|   FbbtnOk.Cancel := True; | ||||
|   FbbtnOk.Default := True; | ||||
|   FbbtnOk.ModalResult := 1; | ||||
|   FbbtnOk.TabOrder := 0; | ||||
|   FbbtnOk.Anchors := [akLeft, akTop, akRight]; | ||||
|   FbbtnOk.Parent := Self; | ||||
| end; | ||||
| 
 | ||||
| function TfrmAbout.GetVersion: String; | ||||
| begin | ||||
|   Result :=  FlblVersion.Caption; | ||||
| end; | ||||
| 
 | ||||
| function TfrmAbout.GetProductName: String; | ||||
| begin | ||||
|   Result := FlblName.Caption; | ||||
| end; | ||||
| 
 | ||||
| function TfrmAbout.GetProductName2: String; | ||||
| begin | ||||
|   Result := FlblName2.Caption; | ||||
| end; | ||||
| 
 | ||||
| procedure TfrmAbout.lblURLClick(Sender: TObject); | ||||
| begin | ||||
|   {$IFDEF WIN32_OR_WIN64} | ||||
|   ShellAPI.ShellExecute(Handle, nil, PChar(FlblURL.Caption), nil, nil, 0);    {Do not Localize} | ||||
|   FlblURL.Font.Color := clPurple; | ||||
|   {$ENDIF} | ||||
| end; | ||||
| 
 | ||||
| procedure TfrmAbout.SetVersion(const AValue: String); | ||||
| begin | ||||
|   FlblVersion.Caption := AValue; | ||||
| end; | ||||
| 
 | ||||
| procedure TfrmAbout.SetProductName(const AValue: String); | ||||
| begin | ||||
|   FlblName.Caption := AValue; | ||||
| end; | ||||
| 
 | ||||
| procedure TfrmAbout.SetProductName2(const AValue: String); | ||||
| begin | ||||
|   FlblName2.Caption := AValue; | ||||
| end; | ||||
| 
 | ||||
| class procedure TfrmAbout.ShowAboutBox(const AProductName, AProductName2, AProductVersion: String); | ||||
| var | ||||
|   LFrm: TfrmAbout; | ||||
| begin | ||||
|   LFrm := TfrmAbout.Create; | ||||
|   {$IFNDEF USE_OBJECT_ARC} | ||||
|   try | ||||
|   {$ENDIF} | ||||
|     LFrm.Version := IndyFormat(RSAAboutBoxVersion, [AProductVersion]); | ||||
|     LFrm.ProductName := AProductName; | ||||
|     LFrm.ProductName2 := AProductName2; | ||||
|     LFrm.ShowModal; | ||||
|   {$IFNDEF USE_OBJECT_ARC} | ||||
|   finally | ||||
|     LFrm.Free; | ||||
|   end; | ||||
|   {$ENDIF} | ||||
| end; | ||||
| 
 | ||||
| class procedure TfrmAbout.ShowDlg; | ||||
| begin | ||||
|   ShowAboutBox(RSAAboutBoxTitle1, RSAAboutBoxTitle2, gsIdVersion); | ||||
| end; | ||||
| 
 | ||||
| constructor TfrmAbout.Create; | ||||
| begin | ||||
|   Create(nil); | ||||
| end; | ||||
| 
 | ||||
| {$IFDEF WIDGET_LCL} | ||||
| initialization | ||||
|   {$i IdAboutVCL.lrs} | ||||
| {$ENDIF} | ||||
| end. | ||||
							
								
								
									
										1
									
								
								indy/Core/IdAboutVCL.rc
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1 @@ | ||||
| INDY_ABOUT_BACKGROUND BITMAP AboutBackground.bmp | ||||
							
								
								
									
										1469
									
								
								indy/Core/IdAboutVCL.xpm
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										161
									
								
								indy/Core/IdAntiFreeze.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,161 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.6    2004.02.03 4:16:42 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.5    2004.01.01 3:13:32 PM  czhower | ||||
|   Updated comment. | ||||
| 
 | ||||
|   Rev 1.4    2003.12.31 10:30:24 PM  czhower | ||||
|   Comment update. | ||||
| 
 | ||||
|   Rev 1.3    2003.12.31 7:25:14 PM  czhower | ||||
|   Now works in .net | ||||
| 
 | ||||
|   Rev 1.2    10/4/2003 9:52:08 AM  GGrieve | ||||
|   add IdCoreGlobal to uses list | ||||
| 
 | ||||
|   Rev 1.1    2003.10.01 1:12:30 AM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:37:36 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdAntiFreeze; | ||||
| 
 | ||||
| { | ||||
|   NOTE - This unit must NOT appear in any Indy uses clauses. This is a ONE way | ||||
|   relationship and is linked in IF the user uses this component. This is done to | ||||
|   preserve the isolation from the massive FORMS unit. | ||||
| 
 | ||||
|   Because it links to Forms: | ||||
| 
 | ||||
|   - The Application.ProcessMessages cannot be done in IdCoreGlobal as an OS | ||||
|     independent function, and thus this unit is allowed to violate the IFDEF | ||||
|     restriction. | ||||
| } | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| uses | ||||
|   Classes, | ||||
|   IdAntiFreezeBase, | ||||
|   IdBaseComponent; | ||||
| 
 | ||||
| { Directive needed for C++Builder HPP and OBJ files for this that will force it | ||||
| to be statically compiled into the code } | ||||
| 
 | ||||
| {$IFDEF HAS_DIRECTIVE_HPPEMIT_LINKUNIT} | ||||
|   {$HPPEMIT LINKUNIT} | ||||
| {$ELSE} | ||||
|   {$IFDEF WINDOWS} | ||||
|     {$HPPEMIT '#pragma link "IdAntiFreeze"'}    {Do not Localize} | ||||
|   {$ENDIF} | ||||
|   {$IFDEF UNIX} | ||||
|     {$HPPEMIT '#pragma link "IdAntiFreeze.o"'}    {Do not Localize} | ||||
|   {$ENDIF} | ||||
| {$ENDIF} | ||||
| 
 | ||||
| type | ||||
|   {$IFDEF HAS_ComponentPlatformsAttribute} | ||||
|   [ComponentPlatformsAttribute( | ||||
|     pidWin32 | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_Win32} or pidWin32{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_Win64} or pidWin64{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_OSX32} or pidOSX32{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_iOS_Simulator} or pidiOSSimulator{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_Android} or pidAndroid{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_Linux32} or pidLinux32{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_iOS_Device32} or pidiOSDevice32{$ELSE} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_iOS_Device} or pidiOSDevice{$ENDIF}{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_WinNX32} or pidWinNX32{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_Linux64} or pidLinux64{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_WinIoT32} or pidWinIoT32{$ENDIF} | ||||
|     {$IFDEF HAS_ComponentPlatformsAttribute_iOS_Device64} or pidiOSDevice64{$ENDIF} | ||||
|   )] | ||||
|   {$ENDIF} | ||||
|   TIdAntiFreeze = class(TIdAntiFreezeBase) | ||||
|   public | ||||
|     procedure Process; override; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF WIDGET_KYLIX} | ||||
|   QForms, | ||||
|   {$ENDIF} | ||||
|   {$IFDEF WIDGET_VCL_LIKE} | ||||
|   Forms, | ||||
|   {$ENDIF} | ||||
|   {$IFDEF WINDOWS} | ||||
|     {$IFNDEF FMX} | ||||
|   Messages, | ||||
|   Windows, | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   {$IFDEF WIDGET_WINFORMS} | ||||
|   System.Windows.Forms, | ||||
|   {$ENDIF} | ||||
|   IdGlobal; | ||||
| 
 | ||||
| {$IFDEF UNIX} | ||||
| procedure TIdAntiFreeze.Process; | ||||
| begin | ||||
|   //TODO: Handle ApplicationHasPriority | ||||
|   Application.ProcessMessages; | ||||
| end; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| {$IFDEF WINDOWS} | ||||
| 
 | ||||
|   {$IFNDEF FMX} | ||||
| procedure TIdAntiFreeze.Process; | ||||
| var | ||||
|   LMsg: TMsg; | ||||
| begin | ||||
|   if ApplicationHasPriority then begin | ||||
|     Application.ProcessMessages; | ||||
|   end else begin | ||||
|     // This guarantees it will not ever call Application.Idle | ||||
|     if PeekMessage(LMsg, 0, 0, 0, PM_NOREMOVE) then begin | ||||
|       Application.HandleMessage; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
|   {$ELSE} | ||||
| procedure TIdAntiFreeze.Process; | ||||
| begin | ||||
|   //TODO: Handle ApplicationHasPriority | ||||
|   Application.ProcessMessages; | ||||
| end; | ||||
|   {$ENDIF} | ||||
| 
 | ||||
| {$ENDIF} | ||||
| 
 | ||||
| {$IFDEF WIDGET_WINFORMS} | ||||
| procedure TIdAntiFreeze.Process; | ||||
| begin | ||||
|   //TODO: Handle ApplicationHasPriority | ||||
|   Application.DoEvents; | ||||
| end; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										1948
									
								
								indy/Core/IdAssignedNumbers.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										1030
									
								
								indy/Core/IdBuffer.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										305
									
								
								indy/Core/IdCmdTCPClient.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,305 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.18    2/8/05 5:24:48 PM  RLebeau | ||||
|   Updated Disconnect() to not wait for the listening thread to terminate until | ||||
|   after the inherited Disconnect() is called, so that the socket is actually | ||||
|   disconnected and the thread can terminate properly. | ||||
| 
 | ||||
|   Rev 1.17    2/1/05 12:38:30 AM  RLebeau | ||||
|   Removed unused CommandHandlersEnabled property | ||||
| 
 | ||||
|   Rev 1.16    6/11/2004 8:48:16 AM  DSiders | ||||
|   Added "Do not Localize" comments. | ||||
| 
 | ||||
|   Rev 1.15    5/18/04 9:12:26 AM  RLebeau | ||||
|   Bug fix for SetExceptionReply() property setter | ||||
| 
 | ||||
|   Rev 1.14    5/16/04 5:18:04 PM  RLebeau | ||||
|   Added setter method to ExceptionReply property | ||||
| 
 | ||||
|   Rev 1.13    5/10/2004 6:10:38 PM  DSiders | ||||
|   Removed unused member var FCommandHandlersInitialized. | ||||
| 
 | ||||
|   Rev 1.12    2004.03.06 1:33:00 PM  czhower | ||||
|   -Change to disconnect | ||||
|   -Addition of DisconnectNotifyPeer | ||||
|   -WriteHeader now write bufers | ||||
| 
 | ||||
|   Rev 1.11    2004.03.01 5:12:24 PM  czhower | ||||
|   -Bug fix for shutdown of servers when connections still existed (AV) | ||||
|   -Implicit HELP support in CMDserver | ||||
|   -Several command handler bugs | ||||
|   -Additional command handler functionality. | ||||
| 
 | ||||
|   Rev 1.10    2004.02.03 4:17:10 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.9    2004.01.20 10:03:22 PM  czhower | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.8    1/4/04 8:46:16 PM  RLebeau | ||||
|   Added OnBeforeCommandHandler and OnAfterCommandHandler events | ||||
| 
 | ||||
|   Rev 1.7    11/4/2003 10:25:40 PM  DSiders | ||||
|   Removed duplicate FReplyClass member in TIdCmdTCPClient (See | ||||
|   TIdTCPConnection). | ||||
| 
 | ||||
|   Rev 1.6    10/21/2003 10:54:20 AM  JPMugaas | ||||
|   Fix for new API change. | ||||
| 
 | ||||
|   Rev 1.5    2003.10.18 9:33:24 PM  czhower | ||||
|   Boatload of bug fixes to command handlers. | ||||
| 
 | ||||
|   Rev 1.4    2003.10.02 10:16:26 AM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.3    2003.09.19 11:54:26 AM  czhower | ||||
|   -Completed more features necessary for servers | ||||
|   -Fixed some bugs | ||||
| 
 | ||||
|   Rev 1.2    7/9/2003 10:55:24 PM  BGooijen | ||||
|   Restored all features | ||||
| 
 | ||||
|   Rev 1.1    7/9/2003 04:36:06 PM  JPMugaas | ||||
|   You now can override the TIdReply with your own type.  This should illiminate | ||||
|   some warnings about some serious issues.  TIdReply is ONLY a base class with | ||||
|   virtual methods. | ||||
| 
 | ||||
|   Rev 1.0    7/7/2003 7:06:40 PM  SPerry | ||||
|   Component that uses command handlers | ||||
| 
 | ||||
|   Rev 1.0    7/6/2003 4:47:26 PM  SPerry | ||||
|   Units that use Command handlers | ||||
| } | ||||
| 
 | ||||
| unit IdCmdTCPClient; | ||||
| 
 | ||||
| { | ||||
|   Original author: Sergio Perry | ||||
|   Description: TCP client that uses CommandHandlers | ||||
| } | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   IdContext, | ||||
|   IdException, | ||||
|   IdGlobal, | ||||
|   IdReply, | ||||
|   IdResourceStringsCore, | ||||
|   IdThread, | ||||
|   IdTCPClient, | ||||
|   IdCommandHandlers; | ||||
| 
 | ||||
| type | ||||
|   TIdCmdTCPClient = class; | ||||
| 
 | ||||
|   { Events } | ||||
|   TIdCmdTCPClientAfterCommandHandlerEvent = procedure(ASender: TIdCmdTCPClient; | ||||
|     AContext: TIdContext) of object; | ||||
|   TIdCmdTCPClientBeforeCommandHandlerEvent = procedure(ASender: TIdCmdTCPClient; | ||||
|     var AData: string; AContext: TIdContext) of object; | ||||
| 
 | ||||
|   { Listening Thread } | ||||
| 
 | ||||
|   TIdCmdClientContext = class(TIdContext) | ||||
|   protected | ||||
|     FClient: TIdCmdTCPClient; | ||||
|   public | ||||
|     property Client: TIdCmdTCPClient read FClient; | ||||
|   end; | ||||
|    | ||||
|   TIdCmdTCPClientListeningThread = class(TIdThread) | ||||
|   protected | ||||
|     FContext: TIdCmdClientContext; | ||||
|     FClient: TIdCmdTCPClient; | ||||
|     FRecvData: String; | ||||
|     // | ||||
|     procedure Run; override; | ||||
|   public | ||||
|     constructor Create(AClient: TIdCmdTCPClient); reintroduce; | ||||
|     destructor Destroy; override; | ||||
|     // | ||||
|     property Client: TIdCmdTCPClient read FClient; | ||||
|     property RecvData: String read FRecvData write FRecvData; | ||||
|   end; | ||||
| 
 | ||||
|   { TIdCmdTCPClient } | ||||
|   TIdCmdTCPClient = class(TIdTCPClient) | ||||
|   protected | ||||
|     FExceptionReply: TIdReply; | ||||
|     FListeningThread: TIdCmdTCPClientListeningThread; | ||||
|     FCommandHandlers: TIdCommandHandlers; | ||||
|     FOnAfterCommandHandler: TIdCmdTCPClientAfterCommandHandlerEvent; | ||||
|     FOnBeforeCommandHandler: TIdCmdTCPClientBeforeCommandHandlerEvent; | ||||
|     // | ||||
|     procedure DoAfterCommandHandler(ASender: TIdCommandHandlers; AContext: TIdContext); | ||||
|     procedure DoBeforeCommandHandler(ASender: TIdCommandHandlers; var AData: string; | ||||
|       AContext: TIdContext); | ||||
|     procedure DoReplyUnknownCommand(AContext: TIdContext; ALine: string); virtual; | ||||
|     function GetCmdHandlerClass: TIdCommandHandlerClass; virtual; | ||||
|     procedure InitComponent; override; | ||||
|     procedure SetCommandHandlers(AValue: TIdCommandHandlers); | ||||
|     procedure SetExceptionReply(AValue: TIdReply); | ||||
|   public | ||||
|     procedure Connect; override; | ||||
|     destructor Destroy; override; | ||||
|     procedure Disconnect(ANotifyPeer: Boolean); override; | ||||
|   published | ||||
|     property CommandHandlers: TIdCommandHandlers read FCommandHandlers write SetCommandHandlers; | ||||
|     property ExceptionReply: TIdReply read FExceptionReply write SetExceptionReply; | ||||
|     // | ||||
|     property OnAfterCommandHandler: TIdCmdTCPClientAfterCommandHandlerEvent | ||||
|       read FOnAfterCommandHandler write FOnAfterCommandHandler; | ||||
|     property OnBeforeCommandHandler: TIdCmdTCPClientBeforeCommandHandlerEvent | ||||
|       read FOnBeforeCommandHandler write FOnBeforeCommandHandler; | ||||
|   end; | ||||
| 
 | ||||
|   EIdCmdTCPClientError = class(EIdException); | ||||
|   EIdCmdTCPClientConnectError = class(EIdCmdTCPClientError); | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdReplyRFC, SysUtils; | ||||
| 
 | ||||
| type | ||||
|   TIdCmdClientContextAccess = class(TIdCmdClientContext) | ||||
|   end; | ||||
| 
 | ||||
| { Listening Thread } | ||||
| 
 | ||||
| constructor TIdCmdTCPClientListeningThread.Create(AClient: TIdCmdTCPClient); | ||||
| begin | ||||
|   FClient := AClient; | ||||
|   FContext := TIdCmdClientContext.Create(AClient, nil, nil); | ||||
|   FContext.FClient := AClient; | ||||
|   TIdCmdClientContextAccess(FContext).FOwnsConnection := False; | ||||
|   // | ||||
|   inherited Create(False); | ||||
| end; | ||||
| 
 | ||||
| destructor TIdCmdTCPClientListeningThread.Destroy; | ||||
| begin | ||||
|   inherited Destroy; | ||||
|   FreeAndNil(FContext); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPClientListeningThread.Run; | ||||
| begin | ||||
|   FRecvData := FClient.IOHandler.ReadLn; | ||||
|   if not FClient.CommandHandlers.HandleCommand(FContext, FRecvData) then begin | ||||
|     FClient.DoReplyUnknownCommand(FContext, FRecvData); | ||||
|   end; | ||||
|   //Synchronize(?); | ||||
|   if not Terminated then begin | ||||
|     FClient.IOHandler.CheckForDisconnect; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| { TIdCmdTCPClient } | ||||
| 
 | ||||
| destructor TIdCmdTCPClient.Destroy; | ||||
| begin | ||||
|   Disconnect; | ||||
|   FreeAndNil(FExceptionReply); | ||||
|   FreeAndNil(FCommandHandlers); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPClient.Connect; | ||||
| begin | ||||
|   inherited Connect; | ||||
|   // | ||||
|   try | ||||
|     FListeningThread := TIdCmdTCPClientListeningThread.Create(Self); | ||||
|   except | ||||
|     Disconnect(True); | ||||
|     IndyRaiseOuterException(EIdCmdTCPClientConnectError.Create(RSNoCreateListeningThread)); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPClient.Disconnect(ANotifyPeer: Boolean); | ||||
| begin | ||||
|   if Assigned(FListeningThread) then begin | ||||
|     FListeningThread.Terminate; | ||||
|   end; | ||||
|   try | ||||
|     inherited Disconnect(ANotifyPeer); | ||||
|   finally | ||||
|     if Assigned(FListeningThread) and not IsCurrentThread(FListeningThread) then begin | ||||
|       FListeningThread.WaitFor; | ||||
|       FreeAndNil(FListeningThread); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPClient.DoAfterCommandHandler(ASender: TIdCommandHandlers; | ||||
|   AContext: TIdContext); | ||||
| begin | ||||
|   if Assigned(OnAfterCommandHandler) then begin | ||||
|     OnAfterCommandHandler(Self, AContext); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPClient.DoBeforeCommandHandler(ASender: TIdCommandHandlers; | ||||
|   var AData: string; AContext: TIdContext); | ||||
| begin | ||||
|   if Assigned(OnBeforeCommandHandler) then begin | ||||
|     OnBeforeCommandHandler(Self, AData, AContext); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPClient.DoReplyUnknownCommand(AContext: TIdContext; ALine: string); | ||||
| begin | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPClient.GetCmdHandlerClass: TIdCommandHandlerClass; | ||||
| begin | ||||
|   Result := TIdCommandHandler; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPClient.InitComponent; | ||||
| var | ||||
|   LHandlerClass: TIdCommandHandlerClass; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
| 
 | ||||
|   FExceptionReply := FReplyClass.Create(nil); | ||||
|   ExceptionReply.SetReply(500, 'Unknown Internal Error'); {do not localize} | ||||
| 
 | ||||
|   LHandlerClass := GetCmdHandlerClass; | ||||
|   FCommandHandlers := TIdCommandHandlers.Create(Self, FReplyClass, nil, ExceptionReply, LHandlerClass); | ||||
|   FCommandHandlers.OnAfterCommandHandler := DoAfterCommandHandler; | ||||
|   FCommandHandlers.OnBeforeCommandHandler := DoBeforeCommandHandler; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPClient.SetCommandHandlers(AValue: TIdCommandHandlers); | ||||
| begin | ||||
|   FCommandHandlers.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPClient.SetExceptionReply(AValue: TIdReply); | ||||
| begin | ||||
|   FExceptionReply.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										535
									
								
								indy/Core/IdCmdTCPServer.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,535 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.42    2/1/05 12:36:36 AM  RLebeau | ||||
|   Removed CommandHandlersEnabled property, no longer used | ||||
| 
 | ||||
|   Rev 1.41    12/2/2004 9:26:42 PM  JPMugaas | ||||
|   Bug fix. | ||||
| 
 | ||||
|   Rev 1.40    2004.10.27 9:20:04 AM  czhower | ||||
|   For TIdStrings | ||||
| 
 | ||||
|   Rev 1.39    10/26/2004 8:42:58 PM  JPMugaas | ||||
|   Should be more portable with new references to TIdStrings and TIdStringList. | ||||
| 
 | ||||
|   Rev 1.38    6/21/04 10:07:14 PM  RLebeau | ||||
|   Updated .DoConnect() to make sure the connection is still connected before | ||||
|   then sending the Greeting | ||||
| 
 | ||||
|   Rev 1.37    6/20/2004 12:01:44 AM  DSiders | ||||
|   Added "Do Not Localize" comments. | ||||
| 
 | ||||
|   Rev 1.36    6/16/04 12:37:06 PM  RLebeau | ||||
|   more compiler errors | ||||
| 
 | ||||
|   Rev 1.35    6/16/04 12:30:32 PM  RLebeau | ||||
|   compiler errors | ||||
| 
 | ||||
|   Rev 1.34    6/16/04 12:12:26 PM  RLebeau | ||||
|   Updated ExceptionReply, Greeting, HelpReply, MaxConnectionReply, and | ||||
|   ReplyUnknownCommand properties to use getter methods that call virtual Create | ||||
|   methods which descendants can override for class-specific initializations | ||||
| 
 | ||||
|   Rev 1.33    5/16/04 5:16:52 PM  RLebeau | ||||
|   Added setter methods to ExceptionReply, HelpReply, and ReplyTexts properties | ||||
| 
 | ||||
|   Rev 1.32    4/19/2004 5:39:58 PM  BGooijen | ||||
|   Added comment | ||||
| 
 | ||||
|   Rev 1.31    4/18/2004 11:58:44 PM  BGooijen | ||||
|   Wasn't thread safe | ||||
| 
 | ||||
|   Rev 1.30    3/3/2004 4:59:38 AM  JPMugaas | ||||
|   Updated for new properties. | ||||
| 
 | ||||
|   Rev 1.29    2004.03.01 5:12:24 PM  czhower | ||||
|   -Bug fix for shutdown of servers when connections still existed (AV) | ||||
|   -Implicit HELP support in CMDserver | ||||
|   -Several command handler bugs | ||||
|   -Additional command handler functionality. | ||||
| 
 | ||||
|   Rev 1.28    2004.02.29 9:43:08 PM  czhower | ||||
|   Added ReadCommandLine. | ||||
| 
 | ||||
|   Rev 1.27    2004.02.29 8:17:18 PM  czhower | ||||
|   Minor cosmetic changes to code. | ||||
| 
 | ||||
|   Rev 1.26    2004.02.03 4:17:08 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.25    03/02/2004 01:49:22  CCostelloe | ||||
|   Added DoReplyUnknownCommand to allow TIdIMAP4Server set a correct reply for | ||||
|   unknown commands | ||||
| 
 | ||||
|   Rev 1.24    1/29/04 9:43:16 PM  RLebeau | ||||
|   Added setter methods to various TIdReply properties | ||||
| 
 | ||||
|   Rev 1.23    2004.01.20 10:03:22 PM  czhower | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.22    1/5/2004 2:35:36 PM  JPMugaas | ||||
|   Removed of object in method declarations. | ||||
| 
 | ||||
|   Rev 1.21    1/5/04 10:12:58 AM  RLebeau | ||||
|   Fixed Typos in OnBeforeCommandHandler and OnAfterCommandHandler events | ||||
| 
 | ||||
|   Rev 1.20    1/4/04 8:45:34 PM  RLebeau | ||||
|   Added OnBeforeCommandHandler and OnAfterCommandHandler events | ||||
| 
 | ||||
|   Rev 1.19    1/1/2004 9:33:22 PM  BGooijen | ||||
|   the abstract class TIdReply was created sometimes, fixed that | ||||
| 
 | ||||
|   Rev 1.18    2003.10.18 9:33:26 PM  czhower | ||||
|   Boatload of bug fixes to command handlers. | ||||
| 
 | ||||
|   Rev 1.17    2003.10.18 8:03:58 PM  czhower | ||||
|   Defaults for codes | ||||
| 
 | ||||
|   Rev 1.16    8/31/2003 11:49:40 AM  BGooijen | ||||
|   removed FReplyClass, this was also in TIdTCPServer | ||||
| 
 | ||||
|   Rev 1.15    7/9/2003 10:55:24 PM  BGooijen | ||||
|   Restored all features | ||||
| 
 | ||||
|   Rev 1.14    7/9/2003 04:36:08 PM  JPMugaas | ||||
|   You now can override the TIdReply with your own type.  This should illiminate | ||||
|   some warnings about some serious issues.  TIdReply is ONLY a base class with | ||||
|   virtual methods. | ||||
| 
 | ||||
|   Rev 1.13    2003.07.08 2:26:02 PM  czhower | ||||
|   Sergio's update | ||||
| 
 | ||||
|   Rev 1.0    7/7/2003 7:06:44 PM  SPerry | ||||
|   Component that uses command handlers | ||||
| 
 | ||||
|   Rev 1.0    7/6/2003 4:47:32 PM  SPerry | ||||
|   Units that use Command handlers | ||||
| 
 | ||||
|   Adapted to IdCommandHandlers.pas SPerry | ||||
| 
 | ||||
|   Rev 1.7    4/4/2003 8:08:00 PM  BGooijen | ||||
|   moved some consts from tidtcpserver here | ||||
| 
 | ||||
|   Rev 1.6    3/23/2003 11:22:24 PM  BGooijen | ||||
|   Moved some code to HandleCommand | ||||
| 
 | ||||
|   Rev 1.5    3/22/2003 1:46:36 PM  BGooijen | ||||
|   Removed unused variables | ||||
| 
 | ||||
|   Rev 1.4    3/20/2003 12:18:30 PM  BGooijen | ||||
|   Moved ReplyExceptionCode from TIdTCPServer to TIdCmdTCPServer | ||||
| 
 | ||||
|   Rev 1.3    3/20/2003 12:14:18 PM  BGooijen | ||||
|   Re-enabled Server.ReplyException | ||||
| 
 | ||||
|   Rev 1.2    2/24/2003 07:21:50 PM  JPMugaas | ||||
|   Now compiles with new core code restructures. | ||||
| 
 | ||||
|   Rev 1.1    1/23/2003 11:06:10 AM  BGooijen | ||||
| 
 | ||||
|   Rev 1.0    1/20/2003 12:48:40 PM  BGooijen | ||||
|   Tcpserver with command handlers, these were originally in TIdTcpServer, but | ||||
|   are now moved here | ||||
| } | ||||
| 
 | ||||
| unit IdCmdTCPServer; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdCommandHandlers, | ||||
|   IdContext, | ||||
|   IdIOHandler, | ||||
|   IdReply, | ||||
|   IdTCPServer, | ||||
|   SysUtils; | ||||
| 
 | ||||
| type | ||||
|   TIdCmdTCPServer = class; | ||||
| 
 | ||||
|   { Events } | ||||
|   TIdCmdTCPServerAfterCommandHandlerEvent = procedure(ASender: TIdCmdTCPServer; | ||||
|     AContext: TIdContext) of object; | ||||
|   TIdCmdTCPServerBeforeCommandHandlerEvent = procedure(ASender: TIdCmdTCPServer; | ||||
|     var AData: string; AContext: TIdContext) of object; | ||||
| 
 | ||||
|   TIdCmdTCPServer = class(TIdTCPServer) | ||||
|   protected | ||||
|     FCommandHandlers: TIdCommandHandlers; | ||||
|     FCommandHandlersInitialized: Boolean; | ||||
|     FExceptionReply: TIdReply; | ||||
|     FHelpReply: TIdReply; | ||||
|     FGreeting: TIdReply; | ||||
|     FMaxConnectionReply: TIdReply; | ||||
|     FOnAfterCommandHandler: TIdCmdTCPServerAfterCommandHandlerEvent; | ||||
|     FOnBeforeCommandHandler: TIdCmdTCPServerBeforeCommandHandlerEvent; | ||||
|     FReplyClass: TIdReplyClass; | ||||
|     FReplyTexts: TIdReplies; | ||||
|     FReplyUnknownCommand: TIdReply; | ||||
|     // | ||||
|     procedure CheckOkToBeActive;  override; | ||||
|     function CreateExceptionReply: TIdReply; virtual; | ||||
|     function CreateGreeting: TIdReply; virtual; | ||||
|     function CreateHelpReply: TIdReply; virtual; | ||||
|     function CreateMaxConnectionReply: TIdReply; virtual; | ||||
|     function CreateReplyUnknownCommand: TIdReply; virtual; | ||||
|     procedure DoAfterCommandHandler(ASender: TIdCommandHandlers; AContext: TIdContext); | ||||
|     procedure DoBeforeCommandHandler(ASender: TIdCommandHandlers; var AData: string; | ||||
|       AContext: TIdContext); | ||||
|     procedure DoConnect(AContext: TIdContext); override; | ||||
|     function DoExecute(AContext: TIdContext): Boolean; override; | ||||
|     procedure DoMaxConnectionsExceeded(AIOHandler: TIdIOHandler); override; | ||||
|     // This is here to allow servers to override this functionality, such as IMAP4 server | ||||
|     procedure DoReplyUnknownCommand(AContext: TIdContext; ALine: string); virtual; | ||||
|     function GetExceptionReply: TIdReply; | ||||
|     function GetGreeting: TIdReply; | ||||
|     function GetHelpReply: TIdReply; | ||||
|     function GetMaxConnectionReply: TIdReply; | ||||
|     function GetRepliesClass: TIdRepliesClass; virtual; | ||||
|     function GetReplyClass: TIdReplyClass; virtual; | ||||
|     function GetReplyUnknownCommand: TIdReply; | ||||
|     procedure InitializeCommandHandlers; virtual; | ||||
|     procedure InitComponent; override; | ||||
|     // This is used by command handlers as the only input. This can be overriden to filter, modify, | ||||
|     // or preparse the input. | ||||
|     function ReadCommandLine(AContext: TIdContext): string; virtual; | ||||
|     procedure Startup; override; | ||||
|     procedure SetCommandHandlers(AValue: TIdCommandHandlers); | ||||
|     procedure SetExceptionReply(AValue: TIdReply); | ||||
|     procedure SetGreeting(AValue: TIdReply); | ||||
|     procedure SetHelpReply(AValue: TIdReply); | ||||
|     procedure SetMaxConnectionReply(AValue: TIdReply); | ||||
|     procedure SetReplyUnknownCommand(AValue: TIdReply); | ||||
|     procedure SetReplyTexts(AValue: TIdReplies); | ||||
|   public | ||||
|     destructor Destroy; override; | ||||
|   published | ||||
|     property CommandHandlers: TIdCommandHandlers read FCommandHandlers | ||||
|       write SetCommandHandlers; | ||||
|     property ExceptionReply: TIdReply read GetExceptionReply write SetExceptionReply; | ||||
|     property Greeting: TIdReply read GetGreeting write SetGreeting; | ||||
|     property HelpReply: TIdReply read GetHelpReply write SetHelpReply; | ||||
|     property MaxConnectionReply: TIdReply read GetMaxConnectionReply | ||||
|       write SetMaxConnectionReply; | ||||
|     property ReplyTexts: TIdReplies read FReplyTexts write SetReplyTexts; | ||||
|     property ReplyUnknownCommand: TIdReply read GetReplyUnknownCommand | ||||
|      write SetReplyUnknownCommand; | ||||
|     // | ||||
|     property OnAfterCommandHandler: TIdCmdTCPServerAfterCommandHandlerEvent | ||||
|       read FOnAfterCommandHandler write FOnAfterCommandHandler; | ||||
|     property OnBeforeCommandHandler: TIdCmdTCPServerBeforeCommandHandlerEvent | ||||
|       read FOnBeforeCommandHandler write FOnBeforeCommandHandler; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdGlobal, | ||||
|   IdResourceStringsCore, | ||||
|   IdReplyRFC; | ||||
| 
 | ||||
| function TIdCmdTCPServer.GetReplyClass: TIdReplyClass; | ||||
| begin | ||||
|   Result := TIdReplyRFC; | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.GetRepliesClass: TIdRepliesClass; | ||||
| begin | ||||
|   Result := TIdRepliesRFC; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdCmdTCPServer.Destroy; | ||||
| begin | ||||
|   inherited Destroy; | ||||
|   FreeAndNil(FReplyUnknownCommand); | ||||
|   FreeAndNil(FReplyTexts); | ||||
|   FreeAndNil(FMaxConnectionReply); | ||||
|   FreeAndNil(FHelpReply); | ||||
|   FreeAndNil(FGreeting); | ||||
|   FreeAndNil(FExceptionReply); | ||||
|   FreeAndNil(FCommandHandlers); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.DoAfterCommandHandler(ASender: TIdCommandHandlers; | ||||
|   AContext: TIdContext); | ||||
| begin | ||||
|   if Assigned(OnAfterCommandHandler) then begin | ||||
|     OnAfterCommandHandler(Self, AContext); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.DoBeforeCommandHandler(ASender: TIdCommandHandlers; | ||||
|   var AData: string; AContext: TIdContext); | ||||
| begin | ||||
|   if Assigned(OnBeforeCommandHandler) then begin | ||||
|     OnBeforeCommandHandler(Self, AData, AContext); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.DoExecute(AContext: TIdContext): Boolean; | ||||
| var | ||||
|   LLine: string; | ||||
| begin | ||||
|   if CommandHandlers.Count > 0 then begin | ||||
|     Result := True; | ||||
|     if AContext.Connection.Connected then begin | ||||
|       LLine := ReadCommandLine(AContext); | ||||
|       // OLX sends blank lines during reset groups (NNTP) and expects no response. | ||||
|       // Not sure what the RFCs say about blank lines. | ||||
|       // I telnetted to some newsservers, and they dont respond to blank lines. | ||||
|       // This unit is core and not NNTP, but we should be consistent. | ||||
|       if LLine <> '' then begin | ||||
|         if not FCommandHandlers.HandleCommand(AContext, LLine) then begin | ||||
|           DoReplyUnknownCommand(AContext, LLine); | ||||
|         end; | ||||
|       end; | ||||
|     end; | ||||
|   end else begin | ||||
|     Result := inherited DoExecute(AContext); | ||||
|   end; | ||||
|   if Result and Assigned(AContext.Connection) then begin | ||||
|     Result := AContext.Connection.Connected; | ||||
|   end; | ||||
|   // the return value is used to determine if the DoExecute needs to be called again by the thread | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.DoReplyUnknownCommand(AContext: TIdContext; ALine: string); | ||||
| var | ||||
|   LReply: TIdReply; | ||||
| begin | ||||
|   if CommandHandlers.PerformReplies then begin | ||||
|     LReply := FReplyClass.CreateWithReplyTexts(nil, ReplyTexts); try | ||||
|       LReply.Assign(ReplyUnknownCommand); | ||||
|       LReply.Text.Add(ALine); | ||||
|       AContext.Connection.IOHandler.Write(LReply.FormattedReply); | ||||
|     finally | ||||
|       FreeAndNil(LReply); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.InitializeCommandHandlers; | ||||
| begin | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.DoConnect(AContext: TIdContext); | ||||
| var | ||||
|   LGreeting: TIdReply; | ||||
| begin | ||||
|   inherited DoConnect(AContext); | ||||
|   // RLebeau - check the connection first in case the application | ||||
|   // chose to disconnect the connection in the OnConnect event handler. | ||||
|   if AContext.Connection.Connected then begin | ||||
|     if Greeting.ReplyExists then begin | ||||
|       ReplyTexts.UpdateText(Greeting); | ||||
|       LGreeting := FReplyClass.Create(nil); try // SendGreeting calls TIdReply.GetFormattedReply | ||||
|         LGreeting.Assign(Greeting);           // and that changes the reply object, so we have to | ||||
|         SendGreeting(AContext, LGreeting);    // clone it to make it thread-safe | ||||
|       finally | ||||
|         FreeAndNil(LGreeting); | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.DoMaxConnectionsExceeded(AIOHandler: TIdIOHandler); | ||||
| begin | ||||
|   inherited DoMaxConnectionsExceeded(AIOHandler); | ||||
|   //Do not UpdateText here - in thread. Is done in constructor | ||||
|   AIOHandler.Write(MaxConnectionReply.FormattedReply); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.Startup; | ||||
| var | ||||
|   i, j: Integer; | ||||
|   LDescr: TStrings; | ||||
|   LHelpList: TStringList; | ||||
|   LHandler, LAddedHandler: TIdCommandHandler; | ||||
| begin | ||||
|   inherited Startup; | ||||
|   if not FCommandHandlersInitialized then begin | ||||
|     // InitializeCommandHandlers must be called only at runtime, and only after streaming | ||||
|     // has occured. This used to be in .Loaded and that worked for forms. It failed | ||||
|     // for dynamically created instances and also for descendant classes. | ||||
|     FCommandHandlersInitialized := True; | ||||
|     InitializeCommandHandlers; | ||||
|     if HelpReply.Code <> '' then begin | ||||
|       LAddedHandler := CommandHandlers.Add; | ||||
|       LAddedHandler.Command := 'Help'; {do not localize} | ||||
|       LAddedHandler.Description.Text := 'Displays commands that the servers supports.'; {do not localize} | ||||
|       LAddedHandler.NormalReply.Assign(HelpReply); | ||||
|       LHelpList := TStringList.Create; | ||||
|       try | ||||
|         for i := 0 to CommandHandlers.Count - 1 do begin | ||||
|           LHandler := CommandHandlers.Items[i]; | ||||
|           if LHandler.HelpVisible then begin | ||||
|             LHelpList.AddObject(LHandler.Command+LHandler.HelpSuperScript, LHandler); | ||||
|           end; | ||||
|         end; | ||||
|         LHelpList.Sort; | ||||
|         for i := 0 to LHelpList.Count - 1 do begin | ||||
|           LAddedHandler.Response.Add(LHelpList[i]); | ||||
|           LDescr := TIdCommandHandler(LHelpList.Objects[i]).Description; | ||||
|           for j := 0 to LDescr.Count - 1 do begin | ||||
|             LAddedHandler.Response.Add('  ' + LDescr[j]); {do not localize} | ||||
|           end; | ||||
|           LAddedHandler.Response.Add(''); {do not localize} | ||||
|         end; | ||||
|       finally | ||||
|         FreeAndNil(LHelpList); | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.SetCommandHandlers(AValue: TIdCommandHandlers); | ||||
| begin | ||||
|   FCommandHandlers.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.CreateExceptionReply: TIdReply; | ||||
| begin | ||||
|   Result := FReplyClass.CreateWithReplyTexts(nil, ReplyTexts); | ||||
|   Result.SetReply(500, 'Unknown Internal Error'); {do not localize} | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.GetExceptionReply: TIdReply; | ||||
| begin | ||||
|   if FExceptionReply = nil then begin | ||||
|     FExceptionReply := CreateExceptionReply; | ||||
|   end; | ||||
|   Result := FExceptionReply; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.SetExceptionReply(AValue: TIdReply); | ||||
| begin | ||||
|   ExceptionReply.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.CreateGreeting: TIdReply; | ||||
| begin | ||||
|   Result := FReplyClass.CreateWithReplyTexts(nil, ReplyTexts); | ||||
|   Result.SetReply(200, 'Welcome'); {do not localize} | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.GetGreeting: TIdReply; | ||||
| begin | ||||
|   if FGreeting = nil then begin | ||||
|     FGreeting := CreateGreeting; | ||||
|   end; | ||||
|   Result := FGreeting; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.SetGreeting(AValue: TIdReply); | ||||
| begin | ||||
|   Greeting.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.CreateHelpReply: TIdReply; | ||||
| begin | ||||
|   Result := FReplyClass.CreateWithReplyTexts(nil, ReplyTexts); | ||||
|   Result.SetReply(100, 'Help follows'); {do not localize} | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.GetHelpReply: TIdReply; | ||||
| begin | ||||
|   if FHelpReply = nil then begin | ||||
|     FHelpReply := CreateHelpReply; | ||||
|   end; | ||||
|   Result := FHelpReply; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.SetHelpReply(AValue: TIdReply); | ||||
| begin | ||||
|   HelpReply.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.CreateMaxConnectionReply: TIdReply; | ||||
| begin | ||||
|   Result := FReplyClass.CreateWithReplyTexts(nil, ReplyTexts); | ||||
|   Result.SetReply(300, 'Too many connections. Try again later.'); {do not localize} | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.GetMaxConnectionReply: TIdReply; | ||||
| begin | ||||
|   if FMaxConnectionReply = nil then begin | ||||
|     FMaxConnectionReply := CreateMaxConnectionReply; | ||||
|   end; | ||||
|   Result := FMaxConnectionReply; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.SetMaxConnectionReply(AValue: TIdReply); | ||||
| begin | ||||
|   MaxConnectionReply.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.CreateReplyUnknownCommand: TIdReply; | ||||
| begin | ||||
|   Result := FReplyClass.CreateWithReplyTexts(nil, ReplyTexts); | ||||
|   Result.SetReply(400, 'Unknown Command'); {do not localize} | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.GetReplyUnknownCommand: TIdReply; | ||||
| begin | ||||
|   if FReplyUnknownCommand = nil then begin | ||||
|     FReplyUnknownCommand := CreateReplyUnknownCommand; | ||||
|   end; | ||||
|   Result := FReplyUnknownCommand; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.SetReplyUnknownCommand(AValue: TIdReply); | ||||
| begin | ||||
|   ReplyUnknownCommand.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.SetReplyTexts(AValue: TIdReplies); | ||||
| begin | ||||
|   FReplyTexts.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FReplyClass := GetReplyClass; | ||||
| 
 | ||||
|   // Before Command handlers as they need FReplyTexts, but after FReplyClass is set | ||||
|   FReplyTexts := GetRepliesClass.Create(Self, FReplyClass); | ||||
| 
 | ||||
|   FCommandHandlers := TIdCommandHandlers.Create(Self, FReplyClass, ReplyTexts, ExceptionReply); | ||||
|   FCommandHandlers.OnAfterCommandHandler := DoAfterCommandHandler; | ||||
|   FCommandHandlers.OnBeforeCommandHandler := DoBeforeCommandHandler; | ||||
| end; | ||||
| 
 | ||||
| function TIdCmdTCPServer.ReadCommandLine(AContext: TIdContext): string; | ||||
| begin | ||||
|   Result := AContext.Connection.IOHandler.ReadLn; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCmdTCPServer.CheckOkToBeActive; | ||||
| begin | ||||
|   if (CommandHandlers.Count = 0) and FCommandHandlersInitialized then begin | ||||
|     inherited CheckOkToBeActive; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										682
									
								
								indy/Core/IdCommandHandlers.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,682 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.36    2/1/05 12:37:48 AM  RLebeau | ||||
|   Removed IdCommandHandlersEnabledDefault variable, no longer used. | ||||
| 
 | ||||
|   Rev 1.35    1/3/05 4:43:20 PM  RLebeau | ||||
|   Changed use of AnsiSameText() to use TextIsSame() instead | ||||
| 
 | ||||
|   Rev 1.34    12/17/04 12:54:04 PM  RLebeau | ||||
|   Updated TIdCommandHandler.Check() to not match misspelled commands when a | ||||
|   CmdDelimiter is specified. | ||||
| 
 | ||||
|   Rev 1.33    12/10/04 1:48:04 PM  RLebeau | ||||
|   Bug fix for TIdCommandHandler.DoCommand() | ||||
| 
 | ||||
|   Rev 1.32    10/26/2004 8:42:58 PM  JPMugaas | ||||
|   Should be more portable with new references to TIdStrings and TIdStringList. | ||||
| 
 | ||||
|   Rev 1.31    6/17/2004 2:19:50 AM  JPMugaas | ||||
|   Problem with unparsed parameters.  The initial deliniator between the command | ||||
|   and reply was being added to Unparsed Params leading some strange results and | ||||
|   command failures. | ||||
| 
 | ||||
|   Rev 1.30    6/6/2004 11:44:34 AM  JPMugaas | ||||
|   Removed a temporary workaround for a Telnet Sequences issue in the | ||||
|   TIdFTPServer.  That workaround is no longer needed as we fixed the issue | ||||
|   another way. | ||||
| 
 | ||||
|   Rev 1.29    5/16/04 5:20:22 PM  RLebeau | ||||
|   Removed local variable from TIdCommandHandler constructor, no longer used | ||||
| 
 | ||||
|   Rev 1.28    2004.03.03 3:19:52 PM  czhower | ||||
|   sorted | ||||
| 
 | ||||
|   Rev 1.27    3/3/2004 4:59:40 AM  JPMugaas | ||||
|   Updated for new properties. | ||||
| 
 | ||||
|   Rev 1.26    3/2/2004 8:10:36 AM  JPMugaas | ||||
|   HelpHide renamed to HelpVisable. | ||||
| 
 | ||||
|   Rev 1.25    3/2/2004 6:37:36 AM  JPMugaas | ||||
|   Updated with properties for more comprehensive help systems. | ||||
| 
 | ||||
|   Rev 1.24    2004.03.01 7:13:40 PM  czhower | ||||
|   Comaptibilty fix. | ||||
| 
 | ||||
|   Rev 1.23    2004.03.01 5:12:26 PM  czhower | ||||
|   -Bug fix for shutdown of servers when connections still existed (AV) | ||||
|   -Implicit HELP support in CMDserver | ||||
|   -Several command handler bugs | ||||
|   -Additional command handler functionality. | ||||
| 
 | ||||
|   Rev 1.22    2004.02.29 9:49:06 PM  czhower | ||||
|   Bug fix, and now responses are also write buffered. | ||||
| 
 | ||||
|   Rev 1.21    2004.02.03 4:17:10 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.20    1/29/04 10:00:40 PM  RLebeau | ||||
|   Added setter methods to various TIdReply properties | ||||
| 
 | ||||
|   Rev 1.19    2003.12.31 7:31:58 PM  czhower | ||||
|   AnsiSameText --> TextIsSame | ||||
| 
 | ||||
|   Rev 1.18    10/19/2003 11:36:52 AM  DSiders | ||||
|   Added localization comments where setting response codes. | ||||
| 
 | ||||
|   Rev 1.17    2003.10.18 9:33:26 PM  czhower | ||||
|   Boatload of bug fixes to command handlers. | ||||
| 
 | ||||
|   Rev 1.16    2003.10.18 8:07:12 PM  czhower | ||||
|   Fixed bug with defaults. | ||||
| 
 | ||||
|   Rev 1.15    2003.10.18 8:03:58 PM  czhower | ||||
|   Defaults for codes | ||||
| 
 | ||||
|   Rev 1.14    10/5/2003 03:06:18 AM  JPMugaas | ||||
|   Should compile. | ||||
| 
 | ||||
|   Rev 1.13    8/9/2003 3:52:44 PM  BGooijen | ||||
|   TIdCommandHandlers can now create any TIdCommandHandler descendant. this | ||||
|   makes it possible to override TIdCommandHandler.check and check for the | ||||
|   command a different way ( binary commands, protocols where the string doesn't | ||||
|   start with the command ) | ||||
| 
 | ||||
|   Rev 1.12    8/2/2003 2:22:54 PM  SPerry | ||||
|   Fixed OnCommandHandlersException problem | ||||
| 
 | ||||
|   Rev 1.11    8/2/2003 1:43:08 PM  SPerry | ||||
|   Modifications to get command handlers to work | ||||
| 
 | ||||
|   Rev 1.9    7/30/2003 10:18:30 PM  SPerry | ||||
|   Fixed AV when creating commandhandler (again) -- for some reason the bug | ||||
|   fixed in Rev. 1.7 was still there. | ||||
| 
 | ||||
|   Rev 1.8    7/30/2003 8:31:58 PM  SPerry | ||||
|   Fixed AV with LFReplyClass. | ||||
| 
 | ||||
|   Rev 1.4    7/9/2003 10:55:26 PM  BGooijen | ||||
|   Restored all features | ||||
| 
 | ||||
|   Rev 1.3    7/9/2003 04:36:10 PM  JPMugaas | ||||
|   You now can override the TIdReply with your own type.  This should illiminate | ||||
|   some warnings about some serious issues.  TIdReply is ONLY a base class with | ||||
|   virtual methods. | ||||
| 
 | ||||
|   Rev 1.2    7/9/2003 01:43:22 PM  JPMugaas | ||||
|   Should now compile. | ||||
| 
 | ||||
|   Rev 1.1    7/9/2003 2:56:44 PM  SPerry | ||||
|   Added OnException event | ||||
| 
 | ||||
| 
 | ||||
|   Rev 1.0    7/6/2003 4:47:38 PM  SPerry | ||||
|   Units that use Command handlers | ||||
| } | ||||
| unit IdCommandHandlers; | ||||
| 
 | ||||
| { | ||||
| 	Original author: Chad Z. Hower | ||||
| 	Separate Unit  : Sergio Perry | ||||
| } | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdBaseComponent, IdComponent, IdReply, IdGlobal, | ||||
|   IdContext, IdReplyRFC; | ||||
| 
 | ||||
| const | ||||
|   IdEnabledDefault = True; | ||||
|   // DO NOT change this default (ParseParams). Many servers rely on this | ||||
|   IdParseParamsDefault = True; | ||||
|   IdHelpVisibleDef = True; | ||||
| type | ||||
|   TIdCommandHandlers = class; | ||||
|   TIdCommandHandler = class; | ||||
|   TIdCommand = class; | ||||
| 
 | ||||
|   { Events } | ||||
|   TIdCommandEvent = procedure(ASender: TIdCommand) of object; | ||||
|   TIdAfterCommandHandlerEvent = procedure(ASender: TIdCommandHandlers; | ||||
|     AContext: TIdContext) of object; | ||||
|   TIdBeforeCommandHandlerEvent = procedure(ASender: TIdCommandHandlers; | ||||
|     var AData: string; AContext: TIdContext) of object; | ||||
|   TIdCommandHandlersExceptionEvent = procedure(ACommand: String; AContext: TIdContext) of object; | ||||
| 
 | ||||
|   { TIdCommandHandler } | ||||
|   TIdCommandHandler = class(TCollectionItem) | ||||
|   protected | ||||
|     FCmdDelimiter: Char; | ||||
|     FCommand: string; | ||||
|     {$IFDEF USE_OBJECT_ARC} | ||||
|     // When ARC is enabled, object references MUST be valid objects. | ||||
|     // It is common for users to store non-object values, though, so | ||||
|     // we will provide separate properties for those purposes | ||||
|     // | ||||
|     // TODO; use TValue instead of separating them | ||||
|     // | ||||
|     FDataObject: TObject; | ||||
|     FDataValue: PtrInt; | ||||
|     {$ELSE} | ||||
|     FData: TObject; | ||||
|     {$ENDIF} | ||||
|     FDescription: TStrings; | ||||
|     FDisconnect: boolean; | ||||
|     FEnabled: boolean; | ||||
|     FExceptionReply: TIdReply; | ||||
|     FHelpSuperScript : String;  //may be something like * or + which should appear in help | ||||
|     FHelpVisible : Boolean; | ||||
|     FName: string; | ||||
|     FNormalReply: TIdReply; | ||||
|     FOnCommand: TIdCommandEvent; | ||||
|     FParamDelimiter: Char; | ||||
|     FParseParams: Boolean; | ||||
|     FReplyClass : TIdReplyClass; | ||||
|     FResponse: TStrings; | ||||
|     FTag: integer; | ||||
|     // | ||||
|     function GetDisplayName: string; override; | ||||
|     procedure SetDescription(AValue: TStrings); | ||||
|     procedure SetExceptionReply(AValue: TIdReply); | ||||
|     procedure SetNormalReply(AValue: TIdReply); | ||||
|     procedure SetResponse(AValue: TStrings); | ||||
|   public | ||||
|     function Check(const AData: string; AContext: TIdContext): boolean; virtual; | ||||
|     procedure DoCommand(const AData: string; AContext: TIdContext; AUnparsedParams: string); virtual; | ||||
|     procedure DoParseParams(AUnparsedParams: string; AParams: TStrings); virtual; | ||||
|     constructor Create(ACollection: TCollection); override; | ||||
|     destructor Destroy; override; | ||||
| //    function GetNamePath: string; override; | ||||
|     function NameIs(const ACommand: string): Boolean; | ||||
|     // | ||||
|     {$IFDEF USE_OBJECT_ARC} | ||||
|     property DataObject: TObject read FDataObject write FDataObject; | ||||
|     property DataValue: PtrInt read FDataValue write FDataValue; | ||||
|     {$ELSE} | ||||
|     property Data: TObject read FData write FData; | ||||
|     {$ENDIF} | ||||
|   published | ||||
|     property CmdDelimiter: Char read FCmdDelimiter write FCmdDelimiter; | ||||
|     property Command: string read FCommand write FCommand; | ||||
|     property Description: TStrings read FDescription write SetDescription; | ||||
|     property Disconnect: boolean read FDisconnect write FDisconnect; | ||||
|     property Enabled: boolean read FEnabled write FEnabled default IdEnabledDefault; | ||||
|     property ExceptionReply: TIdReply read FExceptionReply write SetExceptionReply; | ||||
|     property Name: string read FName write FName; | ||||
|     property NormalReply: TIdReply read FNormalReply write SetNormalReply; | ||||
|     property ParamDelimiter: Char read FParamDelimiter write FParamDelimiter; | ||||
|     property ParseParams: Boolean read FParseParams write FParseParams; | ||||
|     property Response: TStrings read FResponse write SetResponse; | ||||
|     property Tag: Integer read FTag write FTag; | ||||
|     // | ||||
|     property HelpSuperScript : String read FHelpSuperScript write FHelpSuperScript;  //may be something like * or + which should appear in help | ||||
|     property HelpVisible : Boolean read FHelpVisible write FHelpVisible default IdHelpVisibleDef; | ||||
| 
 | ||||
|     property OnCommand: TIdCommandEvent read FOnCommand write FOnCommand; | ||||
|   end; | ||||
| 
 | ||||
|   TIdCommandHandlerClass = class of TIdCommandHandler; | ||||
| 
 | ||||
|   { TIdCommandHandlers } | ||||
|   TIdCommandHandlers = class(TOwnedCollection) | ||||
|   protected | ||||
|     FBase: TIdComponent; | ||||
|     FExceptionReply: TIdReply; | ||||
|     FOnAfterCommandHandler: TIdAfterCommandHandlerEvent; | ||||
|     FOnBeforeCommandHandler: TIdBeforeCommandHandlerEvent; | ||||
|     FOnCommandHandlersException: TIdCommandHandlersExceptionEvent; | ||||
|     FParseParamsDef: Boolean; | ||||
|     FPerformReplies: Boolean; | ||||
|     FReplyClass: TIdReplyClass; | ||||
|     FReplyTexts: TIdReplies; | ||||
|     // | ||||
|     procedure DoAfterCommandHandler(AContext: TIdContext); | ||||
|     procedure DoBeforeCommandHandler(AContext: TIdContext; var VLine: string); | ||||
|     procedure DoOnCommandHandlersException(const ACommand: String; AContext: TIdContext); | ||||
|     function GetItem(AIndex: Integer): TIdCommandHandler; | ||||
|     // This is used instead of the OwnedBy property directly calling GetOwner because | ||||
|     // D5 dies with internal errors and crashes | ||||
| //    function GetOwnedBy: TIdPersistent; | ||||
|     procedure SetItem(AIndex: Integer; const AValue: TIdCommandHandler); | ||||
|   public | ||||
|     function Add: TIdCommandHandler; | ||||
|     constructor Create( | ||||
|       ABase: TIdComponent; | ||||
|       AReplyClass: TIdReplyClass; | ||||
|       AReplyTexts: TIdReplies; | ||||
|       AExceptionReply: TIdReply = nil; | ||||
|       ACommandHandlerClass: TIdCommandHandlerClass = nil | ||||
|       ); reintroduce; | ||||
|     function HandleCommand(AContext: TIdContext; var VCommand: string): Boolean; virtual; | ||||
|     // | ||||
|     property Base: TIdComponent read FBase; | ||||
|     property Items[AIndex: Integer]: TIdCommandHandler read GetItem write SetItem; | ||||
|     // OwnedBy is used so as not to conflict with Owner in D6 | ||||
|     //property OwnedBy: TIdPersistent read GetOwnedBy; | ||||
|     property ParseParamsDefault: Boolean read FParseParamsDef write FParseParamsDef; | ||||
|     property PerformReplies: Boolean read FPerformReplies write FPerformReplies; | ||||
|     property ReplyClass: TIdReplyClass read FReplyClass; | ||||
|     property ReplyTexts: TIdReplies read FReplyTexts; | ||||
|     // | ||||
|     property OnAfterCommandHandler: TIdAfterCommandHandlerEvent read FOnAfterCommandHandler | ||||
|      write FOnAfterCommandHandler; | ||||
|     // Occurs in the context of the peer thread | ||||
|     property OnBeforeCommandHandler: TIdBeforeCommandHandlerEvent read FOnBeforeCommandHandler | ||||
|      write FOnBeforeCommandHandler; | ||||
|     property OnCommandHandlersException: TIdCommandHandlersExceptionEvent read FOnCommandHandlersException | ||||
|       write FOnCommandHandlersException; | ||||
|   end; | ||||
| 
 | ||||
|   { TIdCommand } | ||||
|   TIdCommand = class(TObject) | ||||
|   protected | ||||
|     FCommandHandler: TIdCommandHandler; | ||||
|     FDisconnect: Boolean; | ||||
|     FParams: TStrings; | ||||
|     FPerformReply: Boolean; | ||||
|     FRawLine: string; | ||||
|     FReply: TIdReply; | ||||
|     FResponse: TStrings; | ||||
|     FContext: TIdContext; | ||||
|     FUnparsedParams: string; | ||||
|     FSendEmptyResponse: Boolean; | ||||
|     // | ||||
|     procedure DoCommand; virtual; | ||||
|     procedure SetReply(AValue: TIdReply); | ||||
|     procedure SetResponse(AValue: TStrings); | ||||
|   public | ||||
|     constructor Create(AOwner: TIdCommandHandler); virtual; | ||||
|     destructor Destroy; override; | ||||
|     procedure SendReply; | ||||
|     // | ||||
|     property CommandHandler: TIdCommandHandler read FCommandHandler; | ||||
|     property Disconnect: Boolean read FDisconnect write FDisconnect; | ||||
|     property PerformReply: Boolean read FPerformReply write FPerformReply; | ||||
|     property Params: TStrings read FParams; | ||||
|     property RawLine: string read FRawLine; | ||||
|     property Reply: TIdReply read FReply write SetReply; | ||||
|     property Response: TStrings read FResponse write SetResponse; | ||||
|     property Context: TIdContext read FContext; | ||||
|     property UnparsedParams: string read FUnparsedParams; | ||||
|     property SendEmptyResponse: Boolean read FSendEmptyResponse write FSendEmptyResponse; | ||||
|   end;//TIdCommand | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   SysUtils; | ||||
| 
 | ||||
| { TIdCommandHandlers } | ||||
| 
 | ||||
| constructor TIdCommandHandlers.Create( | ||||
|   ABase: TIdComponent; | ||||
|   AReplyClass: TIdReplyClass; | ||||
|   AReplyTexts: TIdReplies; | ||||
|   AExceptionReply: TIdReply = nil; | ||||
|   ACommandHandlerClass: TIdCommandHandlerClass = nil | ||||
|   ); | ||||
| begin | ||||
|   if ACommandHandlerClass = nil then begin | ||||
|     ACommandHandlerClass := TIdCommandHandler; | ||||
|   end; | ||||
|   inherited Create(ABase, ACommandHandlerClass); | ||||
|   FBase := ABase; | ||||
|   FExceptionReply := AExceptionReply; | ||||
|   FParseParamsDef := IdParseParamsDefault; | ||||
|   FPerformReplies := True;  // RLebeau: default to legacy behavior | ||||
|   FReplyClass := AReplyClass; | ||||
|   FReplyTexts := AReplyTexts; | ||||
| end; | ||||
| 
 | ||||
| function TIdCommandHandlers.Add: TIdCommandHandler; | ||||
| begin | ||||
|   Result := TIdCommandHandler(inherited Add); | ||||
| end; | ||||
| 
 | ||||
| function TIdCommandHandlers.HandleCommand(AContext: TIdContext; | ||||
|   var VCommand: string): Boolean; | ||||
| var | ||||
|   i, j: Integer; | ||||
| begin | ||||
|   j := Count - 1; | ||||
|   Result := False; | ||||
|   DoBeforeCommandHandler(AContext, VCommand); try | ||||
|     i := 0; | ||||
|     while i <= j do begin | ||||
|       if Items[i].Enabled then begin | ||||
|         Result := Items[i].Check(VCommand, AContext); | ||||
|         if Result then begin | ||||
|           Break; | ||||
|         end; | ||||
|       end; | ||||
|       Inc(i); | ||||
|     end; | ||||
|   finally DoAfterCommandHandler(AContext); end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommandHandlers.DoAfterCommandHandler(AContext: TIdContext); | ||||
| begin | ||||
|   if Assigned(OnAfterCommandHandler) then begin | ||||
|     OnAfterCommandHandler(Self, AContext); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommandHandlers.DoBeforeCommandHandler(AContext: TIdContext; | ||||
|   var VLine: string); | ||||
| begin | ||||
|   if Assigned(OnBeforeCommandHandler) then begin | ||||
|     OnBeforeCommandHandler(Self, VLine, AContext); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommandHandlers.DoOnCommandHandlersException(const ACommand: String; | ||||
|   AContext: TIdContext); | ||||
| begin | ||||
|   if Assigned(FOnCommandHandlersException) then begin | ||||
|     OnCommandHandlersException(ACommand, AContext); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdCommandHandlers.GetItem(AIndex: Integer): TIdCommandHandler; | ||||
| begin | ||||
|   Result := TIdCommandHandler(inherited Items[AIndex]); | ||||
| end; | ||||
| 
 | ||||
| { | ||||
| function TIdCommandHandlers.GetOwnedBy: TIdPersistent; | ||||
| begin | ||||
|   Result := GetOwner; | ||||
| end; | ||||
|  } | ||||
| 
 | ||||
| procedure TIdCommandHandlers.SetItem(AIndex: Integer; const AValue: TIdCommandHandler); | ||||
| begin | ||||
|   inherited SetItem(AIndex, AValue); | ||||
| end; | ||||
| 
 | ||||
| { TIdCommandHandler } | ||||
| 
 | ||||
| procedure TIdCommandHandler.DoCommand(const AData: string; AContext: TIdContext; AUnparsedParams: string); | ||||
| var | ||||
|   LCommand: TIdCommand; | ||||
| begin | ||||
|   LCommand := TIdCommand.Create(Self); | ||||
|   try | ||||
|     LCommand.FRawLine := AData; | ||||
|     LCommand.FContext := AContext; | ||||
|     LCommand.FUnparsedParams := AUnparsedParams; | ||||
| 
 | ||||
|     if ParseParams then begin | ||||
|       DoParseParams(AUnparsedParams, LCommand.Params); | ||||
|     end; | ||||
| 
 | ||||
|     // RLebeau 2/21/08: for the IRC protocol, RFC 2812 section 2.4 says that | ||||
|     // clients are not allowed to issue numeric replies for server-issued | ||||
|     // commands.  Added the PerformReplies property so TIdIRC can specify | ||||
|     // that behavior. | ||||
|     if Collection is TIdCommandHandlers then begin | ||||
|       LCommand.PerformReply := TIdCommandHandlers(Collection).PerformReplies; | ||||
|     end; | ||||
| 
 | ||||
|     try | ||||
|       if (LCommand.Reply.Code = '') and (NormalReply.Code <> '') then begin | ||||
|         LCommand.Reply.Assign(NormalReply); | ||||
|       end; | ||||
| 
 | ||||
|       //if code<>'' before DoCommand, then it breaks exception handling | ||||
|       Assert(LCommand.Reply.Code <> ''); | ||||
|       LCommand.DoCommand; | ||||
| 
 | ||||
|       if LCommand.Reply.Code = '' then begin | ||||
|         LCommand.Reply.Assign(NormalReply); | ||||
|       end; | ||||
|       // UpdateText here in case user wants to add to it. SendReply also gets it in case | ||||
|       // a different reply is sent (ie exception, etc), or the user changes the code in the event | ||||
|       LCommand.Reply.UpdateText; | ||||
|     except | ||||
|       on E: Exception do begin | ||||
|         // If there is an unhandled exception, we override all replies | ||||
|         // If nothing specified to override with, we throw the exception again. | ||||
|         // If the user wants a custom value on exception other, its their responsibility | ||||
|         // to catch it before it reaches us | ||||
|         LCommand.Reply.Clear; | ||||
|         if LCommand.PerformReply then begin | ||||
|           // Try from command handler first | ||||
|           if ExceptionReply.Code <> '' then begin | ||||
|             LCommand.Reply.Assign(ExceptionReply); | ||||
|           // If still no go, from server | ||||
|           // Can be nil though. Typically only servers pass it in | ||||
|           end else if (Collection is TIdCommandHandlers) and (TIdCommandHandlers(Collection).FExceptionReply <> nil) then begin | ||||
|             LCommand.Reply.Assign(TIdCommandHandlers(Collection).FExceptionReply); | ||||
|           end; | ||||
|           if LCommand.Reply.Code <> '' then begin | ||||
|             //done this way in case an exception message has more than one line. | ||||
|             //otherwise you could get something like this: | ||||
|             // | ||||
|             // 550 System Error.  Code: 2 | ||||
|             // The system cannot find the file specified | ||||
|             // | ||||
|             //and the second line would throw off some clients. | ||||
|             LCommand.Reply.Text.Text := E.Message; | ||||
|             //Reply.Text.Add(E.Message); | ||||
|             LCommand.SendReply; | ||||
|           end else begin | ||||
|             raise; | ||||
|           end; | ||||
|         end else begin | ||||
|           raise; | ||||
|         end; | ||||
|       end else begin | ||||
|         raise; | ||||
|       end; | ||||
|     end; | ||||
| 
 | ||||
|     if LCommand.PerformReply then begin | ||||
|       LCommand.SendReply; | ||||
|     end; | ||||
| 
 | ||||
|     if (LCommand.Response.Count > 0) or LCommand.SendEmptyResponse then begin | ||||
|       AContext.Connection.WriteRFCStrings(LCommand.Response); | ||||
|     end else if Response.Count > 0 then begin | ||||
|       AContext.Connection.WriteRFCStrings(Response); | ||||
|     end; | ||||
|   finally | ||||
|     try | ||||
|       if LCommand.Disconnect then begin | ||||
|         AContext.Connection.Disconnect; | ||||
|       end; | ||||
|     finally | ||||
|       LCommand.Free; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommandHandler.DoParseParams(AUnparsedParams: string; AParams: TStrings); | ||||
| // AUnparsedParams is not preparsed and is completely left up to the command handler. This will | ||||
| // allow for future expansion such as multiple delimiters etc, and allow the logic to properly | ||||
| // remain in each of the command handler implementations. In the future there may be a base type | ||||
| // and multiple descendants | ||||
| begin | ||||
|   AParams.Clear; | ||||
|   SplitDelimitedString(AUnparsedParams, AParams, FParamDelimiter <> #32, FParamDelimiter); | ||||
| end; | ||||
| 
 | ||||
| function TIdCommandHandler.Check(const AData: string; AContext: TIdContext): boolean; | ||||
| // AData is not preparsed and is completely left up to the command handler. This will allow for | ||||
| // future expansion such as wild cards etc, and allow the logic to properly remain in each of the | ||||
| // command handler implementations. In the future there may be a base type and multiple descendants | ||||
| var | ||||
|   LUnparsedParams: string; | ||||
| begin | ||||
|   LUnparsedParams := ''; | ||||
|   Result := TextIsSame(AData, Command); // Command by itself | ||||
| 
 | ||||
|   if not Result then begin | ||||
|     if CmdDelimiter <> #0 then begin | ||||
|       Result := TextStartsWith(AData, Command + CmdDelimiter); | ||||
|       if Result then begin | ||||
|         LUnparsedParams := Copy(AData, Length(Command) + 2, MaxInt); | ||||
|       end; | ||||
|     end else begin | ||||
|       // Dont strip any part of the params out.. - just remove the command purely on length and | ||||
|       // no delim | ||||
|       Result := TextStartsWith(AData, Command); | ||||
|       if Result then begin | ||||
|         LUnparsedParams := Copy(AData, Length(Command) + 1, MaxInt); | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
| 
 | ||||
|   if Result then begin | ||||
|     DoCommand(AData, AContext, LUnparsedParams); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| constructor TIdCommandHandler.Create(ACollection: TCollection); | ||||
| begin | ||||
|   inherited Create(ACollection); | ||||
| 
 | ||||
|   FReplyClass := TIdCommandHandlers(ACollection).ReplyClass; | ||||
|   if FReplyClass = nil then begin | ||||
|     FReplyClass := TIdReplyRFC; | ||||
|   end; | ||||
| 
 | ||||
|   FCmdDelimiter := #32; | ||||
|   FEnabled := IdEnabledDefault; | ||||
|   FName := ClassName + IntToStr(ID); | ||||
|   FParamDelimiter := #32; | ||||
|   FParseParams := TIdCommandHandlers(ACollection).ParseParamsDefault; | ||||
|   FResponse := TStringList.Create; | ||||
|   FDescription := TStringList.Create; | ||||
| 
 | ||||
|   FNormalReply := FReplyClass.CreateWithReplyTexts(nil, TIdCommandHandlers(ACollection).ReplyTexts); | ||||
|   if FNormalReply is TIdReplyRFC then begin | ||||
|     FNormalReply.Code := '200'; {do not localize} | ||||
|   end; | ||||
|   FHelpVisible := IdHelpVisibleDef; | ||||
|   // Dont initialize, pulls from CmdTCPServer for defaults | ||||
|   FExceptionReply := FReplyClass.CreateWithReplyTexts(nil, TIdCommandHandlers(ACollection).ReplyTexts); | ||||
| end; | ||||
| 
 | ||||
| destructor TIdCommandHandler.Destroy; | ||||
| begin | ||||
|   FreeAndNil(FResponse); | ||||
|   FreeAndNil(FNormalReply); | ||||
|   FreeAndNil(FDescription); | ||||
|   FreeAndNil(FExceptionReply); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| function TIdCommandHandler.GetDisplayName: string; | ||||
| begin | ||||
|   if Command = '' then begin | ||||
|     Result := Name; | ||||
|   end else begin | ||||
|     Result := Command; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| { | ||||
| function TIdCommandHandler.GetNamePath: string; | ||||
| begin | ||||
|   if Collection <> nil then begin | ||||
|     // OwnedBy is used because D4/D5 dont expose Owner on TOwnedCollection but D6 does | ||||
|     Result := TIdCommandHandlers(Collection).OwnedBy.GetNamePath + '.' + Name; | ||||
|   end else begin | ||||
|     Result := inherited GetNamePath; | ||||
|   end; | ||||
| end; | ||||
| } | ||||
| 
 | ||||
| function TIdCommandHandler.NameIs(const ACommand: string): Boolean; | ||||
| begin | ||||
|   Result := TextIsSame(ACommand, FName); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommandHandler.SetExceptionReply(AValue: TIdReply); | ||||
| begin | ||||
|   FExceptionReply.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommandHandler.SetNormalReply(AValue: TIdReply); | ||||
| begin | ||||
|   FNormalReply.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommandHandler.SetResponse(AValue: TStrings); | ||||
| begin | ||||
|   FResponse.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommandHandler.SetDescription(AValue: TStrings); | ||||
| begin | ||||
|   FDescription.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| { TIdCommand } | ||||
| 
 | ||||
| constructor TIdCommand.Create(AOwner: TIdCommandHandler); | ||||
| begin | ||||
|   inherited Create; | ||||
|   FParams := TStringList.Create; | ||||
|   FReply := AOwner.FReplyClass.CreateWithReplyTexts(nil, TIdCommandHandlers(AOwner.Collection).ReplyTexts); | ||||
|   FResponse := TStringList.Create; | ||||
|   FCommandHandler := AOwner; | ||||
|   FDisconnect := AOwner.Disconnect; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdCommand.Destroy; | ||||
| begin | ||||
|   FreeAndNil(FReply); | ||||
|   FreeAndNil(FResponse); | ||||
|   FreeAndNil(FParams); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommand.DoCommand; | ||||
| begin | ||||
|   if Assigned(CommandHandler.OnCommand) then begin | ||||
|     CommandHandler.OnCommand(Self); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommand.SendReply; | ||||
| begin | ||||
|   PerformReply := False; | ||||
|   Reply.UpdateText; | ||||
|   Context.Connection.IOHandler.Write(Reply.FormattedReply); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommand.SetReply(AValue: TIdReply); | ||||
| begin | ||||
|   FReply.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCommand.SetResponse(AValue: TStrings); | ||||
| begin | ||||
|   FResponse.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										1687
									
								
								indy/Core/IdCompilerDefines.inc
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										220
									
								
								indy/Core/IdContext.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,220 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.14    6/16/2004 2:08:48 PM  JPMugaas | ||||
|   Binding made public for the FTP Server. | ||||
| 
 | ||||
|   Rev 1.13    6/4/2004 1:34:24 PM  DSiders | ||||
|   Removed unused TIdContextDoRun, TIdContextMethod types. | ||||
| 
 | ||||
|   Rev 1.12    2004.02.03 4:17:08 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.11    21.1.2004 ã. 12:31:04  DBondzhev | ||||
|   Fix for Indy source. Workaround for dccil bug | ||||
|   now it can be compiled using Compile instead of build | ||||
| 
 | ||||
|   Rev 1.10    2003.10.21 12:18:58 AM  czhower | ||||
|   TIdTask support and fiber bug fixes. | ||||
| 
 | ||||
|   Rev 1.9    2003.10.11 5:47:18 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.8    2003.09.19 11:54:28 AM  czhower | ||||
|   -Completed more features necessary for servers | ||||
|   -Fixed some bugs | ||||
| 
 | ||||
|   Rev 1.7    3/22/2003 09:45:26 PM  JPMugaas | ||||
|   Now should compile under D4. | ||||
| 
 | ||||
|   Rev 1.6    3/13/2003 10:18:38 AM  BGooijen | ||||
|   Server side fibers, bug fixes | ||||
| 
 | ||||
|   Rev 1.5    1/31/2003 7:24:18 PM  BGooijen | ||||
|   Added a .Binding function | ||||
| 
 | ||||
|   Rev 1.4    1/23/2003 8:33:20 PM  BGooijen | ||||
| 
 | ||||
|   Rev 1.3    1/23/2003 11:06:06 AM  BGooijen | ||||
| 
 | ||||
| 
 | ||||
|   Rev 1.2    1-17-2003 23:58:30  BGooijen | ||||
|   removed OnCreate/OnDestroy again, they had no use | ||||
| 
 | ||||
|   Rev 1.0    1-17-2003 22:28:58  BGooijen | ||||
| } | ||||
| 
 | ||||
| unit IdContext; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$i IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdSocketHandle, IdTCPConnection, IdTask, IdYarn, IdThreadSafe, | ||||
|   {$IFDEF HAS_GENERICS_TThreadList} | ||||
|   System.Generics.Collections, | ||||
|   {$ENDIF} | ||||
|   SysUtils; | ||||
| 
 | ||||
| type | ||||
|   TIdContext = class; | ||||
|   TIdContextClass = class of TIdContext; | ||||
|   TIdContextRun = function(AContext: TIdContext): Boolean of object; | ||||
|   TIdContextEvent = procedure(AContext: TIdContext) of object; | ||||
|   TIdContextExceptionEvent = procedure(AContext: TIdContext; AException: Exception) of object; | ||||
| 
 | ||||
|   {$IFDEF HAS_GENERICS_TThreadList} | ||||
|   TIdContextThreadList = TIdThreadSafeObjectList<TIdContext>; | ||||
|   TIdContextList = TList<TIdContext>; | ||||
|   {$ELSE} | ||||
|   // TODO: flesh out to match TThreadList<TIdContext> and TList<TIdContext> for non-Generics compilers | ||||
|   TIdContextThreadList = TIdThreadSafeObjectList; | ||||
|   TIdContextList = TList; | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   TIdContext = class(TIdTask) | ||||
|   protected | ||||
|     // A list in which this context is registered, this can be nil, and should | ||||
|     // therefore not be used | ||||
|     FContextList: TIdContextThreadList; | ||||
|     FConnection: TIdTCPConnection; // TODO: should this be [Weak] on ARC systems? | ||||
|     FOwnsConnection: Boolean; | ||||
|     FOnRun: TIdContextRun; | ||||
|     FOnBeforeRun: TIdContextEvent; | ||||
|     FOnAfterRun: TIdContextEvent; | ||||
|     FOnException: TIdContextExceptionEvent; | ||||
|     // | ||||
|     procedure BeforeRun; override; | ||||
|     function Run: Boolean; override; | ||||
|     procedure AfterRun; override; | ||||
|     procedure HandleException(AException: Exception); override; | ||||
|     function GetBinding: TIdSocketHandle; | ||||
|   public | ||||
|     constructor Create( | ||||
|       AConnection: TIdTCPConnection; | ||||
|       AYarn: TIdYarn; | ||||
|       AList: TIdContextThreadList = nil | ||||
|       ); reintroduce; virtual; | ||||
|     destructor Destroy; override; | ||||
|     procedure RemoveFromList; | ||||
|     // | ||||
|     property Binding: TIdSocketHandle read GetBinding; | ||||
|     property Connection: TIdTCPConnection read FConnection; | ||||
|     // | ||||
|     property OnAfterRun: TIdContextEvent read FOnAfterRun write FOnAfterRun; | ||||
|     property OnBeforeRun: TIdContextEvent read FOnBeforeRun write FOnBeforeRun; | ||||
|     property OnRun: TIdContextRun read FOnRun write FOnRun; | ||||
|     property OnException: TIdContextExceptionEvent read FOnException write FOnException; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| { TIdContext } | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF VCL_XE3_OR_ABOVE} | ||||
|   System.Types, | ||||
|   {$ENDIF} | ||||
|   IdGlobal, | ||||
|   IdIOHandlerSocket; | ||||
| 
 | ||||
| constructor TIdContext.Create(AConnection: TIdTCPConnection; AYarn: TIdYarn; | ||||
|   AList: TIdContextThreadList = nil); | ||||
| begin | ||||
|   inherited Create(AYarn); | ||||
|   FConnection := AConnection; | ||||
|   FOwnsConnection := True; | ||||
|   FContextList := AList; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdContext.Destroy; | ||||
| begin | ||||
|   if Assigned(FContextList) then begin | ||||
|     FContextList.Remove(Self); | ||||
|   end; | ||||
| 
 | ||||
|   if FOwnsConnection then begin | ||||
|     IdDisposeAndNil(FConnection); | ||||
|   end; | ||||
| 
 | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdContext.RemoveFromList; | ||||
| begin | ||||
|   FContextList := nil; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdContext.BeforeRun; | ||||
| begin | ||||
|   //Context must be added to ContextList outside of create. This avoids | ||||
|   //the possibility of another thread accessing a context (specifically | ||||
|   //a subclass) that is still creating. similar logic for remove/destroy. | ||||
|   if Assigned(FContextList) then begin | ||||
|     FContextList.Add(Self); | ||||
|   end; | ||||
| 
 | ||||
|   if Assigned(OnBeforeRun) then begin | ||||
|     OnBeforeRun(Self); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdContext.Run: Boolean; | ||||
| begin | ||||
|   if Assigned(OnRun) then begin | ||||
|     Result := OnRun(Self); | ||||
|   end else begin | ||||
|     Result := True; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdContext.AfterRun; | ||||
| begin | ||||
|   if Assigned(OnAfterRun) then begin | ||||
|     OnAfterRun(Self); | ||||
|   end; | ||||
| 
 | ||||
|   if FContextList <> nil then begin | ||||
|     FContextList.Remove(Self); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdContext.HandleException(AException: Exception); | ||||
| begin | ||||
|   if Assigned(OnException) then begin | ||||
|     OnException(Self, AException); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdContext.GetBinding: TIdSocketHandle; | ||||
| begin | ||||
|   Result := nil; | ||||
|   if Connection <> nil then begin | ||||
|     if Connection.Socket <> nil then begin | ||||
|       Result := Connection.Socket.Binding; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
| 
 | ||||
							
								
								
									
										12
									
								
								indy/Core/IdCore90ASM90.inc
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,12 @@ | ||||
| [assembly: AssemblyDescription('Internet Direct (Indy) 10.6.2 Core Run-Time Package for Borland Developer Studio')] | ||||
| [assembly: AssemblyConfiguration('')] | ||||
| [assembly: AssemblyCompany('Chad Z. Hower a.k.a Kudzu and the Indy Pit Crew')] | ||||
| [assembly: AssemblyProduct('Indy for Microsoft .NET Framework')] | ||||
| [assembly: AssemblyCopyright('Copyright © 1993 - 2015 Chad Z. Hower a.k.a Kudzu and the Indy Pit Crew')] | ||||
| [assembly: AssemblyTrademark('')] | ||||
| [assembly: AssemblyCulture('')] | ||||
| [assembly: AssemblyTitle('Indy .NET Core Run-Time Package')] | ||||
| [assembly: AssemblyVersion('10.6.2.*')] | ||||
| [assembly: AssemblyDelaySign(false)] | ||||
| [assembly: AssemblyKeyFile('')] | ||||
| [assembly: AssemblyKeyName('')] | ||||
							
								
								
									
										244
									
								
								indy/Core/IdCoreDsnRegister.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,244 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.4    12/10/2004 15:36:40  HHariri | ||||
|   Fix so it works with D8 too | ||||
| 
 | ||||
|   Rev 1.3    9/5/2004 2:08:14 PM  JPMugaas | ||||
|   Should work in D9 NET. | ||||
| 
 | ||||
|   Rev 1.2    2/3/2004 11:42:52 AM  JPMugaas | ||||
|   Fixed for new design. | ||||
| 
 | ||||
|   Rev 1.1    2/1/2004 2:44:20 AM  JPMugaas | ||||
|   Bindings editor should be fully functional including IPv6 support. | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:41:18 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdCoreDsnRegister; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF DOTNET} | ||||
|   Borland.Vcl.Design.DesignIntF, | ||||
|   Borland.Vcl.Design.DesignEditors | ||||
|   {$ELSE} | ||||
|     {$IFDEF FPC} | ||||
|   PropEdits, | ||||
|   ComponentEditors | ||||
|     {$ELSE} | ||||
|       {$IFDEF VCL_6_OR_ABOVE} | ||||
|   DesignIntf, | ||||
|   DesignEditors | ||||
|       {$ELSE} | ||||
|   Dsgnintf | ||||
|       {$ENDIF} | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   ; | ||||
| 
 | ||||
| type | ||||
|   {$IFDEF FPC} | ||||
|   TIdBaseComponentEditor = class(TDefaultComponentEditor) | ||||
|   {$ELSE} | ||||
|   TIdBaseComponentEditor = class(TDefaultEditor) | ||||
|   {$ENDIF} | ||||
|   public | ||||
|     procedure ExecuteVerb(Index: Integer); override; | ||||
|     function GetVerb(Index: Integer): string; override; | ||||
|     function GetVerbCount: Integer; override; | ||||
|   end; | ||||
| 
 | ||||
|   {$IFDEF FPC} | ||||
|   TIdPropEdBinding = class(TPropertyEditor) | ||||
|   protected | ||||
|     FValue : String; | ||||
|     property Value : String read FValue write FValue; | ||||
|   {$ELSE} | ||||
|   TIdPropEdBinding = class(TClassProperty) | ||||
|   {$ENDIF} | ||||
|   public | ||||
|     procedure Edit; override; | ||||
|     function GetAttributes: TPropertyAttributes; override; | ||||
|     function GetValue: string; override; | ||||
|     procedure SetValue(const Value: string); override; | ||||
|   end; | ||||
| 
 | ||||
| // Procs | ||||
|   procedure Register; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   {$IFDEF WIDGET_WINFORMS} | ||||
|   IdDsnPropEdBindingNET, | ||||
|   IdAboutDotNET, | ||||
|   {$ELSE} | ||||
|   IdDsnPropEdBindingVCL, | ||||
|   IdAboutVCL, | ||||
|   {$ENDIF} | ||||
|   IdDsnCoreResourceStrings, | ||||
|   IdBaseComponent, | ||||
|   IdComponent, | ||||
|   IdGlobal, | ||||
|   IdStack, | ||||
|   IdSocketHandle; | ||||
| 
 | ||||
| { | ||||
|   Design Note:  It turns out that in DotNET, there are no services file functions and | ||||
|   IdPorts does not work as expected in DotNET.  It is probably possible to read the | ||||
|   services file ourselves but that creates some portability problems as the placement | ||||
|  is different in every operating system. | ||||
| 
 | ||||
|   e.g. | ||||
| 
 | ||||
|   Linux and Unix-like systems - /etc | ||||
|   Windows 95, 98, and ME - c:\windows | ||||
|   Windows NT systems - c:\winnt\system32\drivers\etc | ||||
| 
 | ||||
|   Thus, it will undercut whatever benefit we could get with DotNET. | ||||
| 
 | ||||
|   About the best I could think of is to use an edit control because | ||||
|   we can't offer anything from the services file in DotNET. | ||||
| 
 | ||||
|   TODO:  Maybe there might be a way to find the location in a more elegant | ||||
|   manner than what I described. | ||||
| } | ||||
| 
 | ||||
| type | ||||
|   {$IFDEF WIDGET_WINFORMS} | ||||
|    TIdPropEdBindingEntry = TIdDsnPropEdBindingNET; | ||||
|   {$ELSE} | ||||
|   TIdPropEdBindingEntry = TIdDsnPropEdBindingVCL; | ||||
|   {$ENDIF} | ||||
| 
 | ||||
| procedure TIdPropEdBinding.Edit; | ||||
| var | ||||
|   pSockets: TIdSocketHandles; | ||||
|   pEntry: TIdPropEdBindingEntry; | ||||
| begin | ||||
|   inherited Edit; | ||||
| 
 | ||||
|   {$IFNDEF DOTNET} | ||||
|   pSockets := TIdSocketHandles( | ||||
|     {$IFDEF CPU64} | ||||
|     GetInt64Value | ||||
|     {$ELSE} | ||||
|     GetOrdValue | ||||
|     {$ENDIF} | ||||
|   ); | ||||
|   {$ELSE} | ||||
|   pSockets := GetObjValue as TIdSocketHandles; | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   pEntry := TIdPropEdBindingEntry.Create; | ||||
|   try | ||||
|     pEntry.Caption := TComponent(GetComponent(0)).Name; | ||||
|     pEntry.DefaultPort := pSockets.DefaultPort; | ||||
|     Value := GetListValues(pSockets); | ||||
|     pEntry.SetList(Value); | ||||
|     if pEntry.Execute then | ||||
|     begin | ||||
|       Value := pEntry.GetList; | ||||
|       FillHandleList(Value, pSockets); | ||||
|     end; | ||||
|   finally | ||||
|     pEntry.Free; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdPropEdBinding.GetAttributes: TPropertyAttributes; | ||||
| begin | ||||
|   Result := inherited GetAttributes + [paDialog]; | ||||
| end; | ||||
| 
 | ||||
| function TIdPropEdBinding.GetValue: string; | ||||
| var | ||||
|   pSockets: TIdSocketHandles; | ||||
| begin | ||||
|   {$IFNDEF DOTNET} | ||||
|   pSockets := TIdSocketHandles( | ||||
|     {$IFDEF CPU64} | ||||
|     GetInt64Value | ||||
|     {$ELSE} | ||||
|     GetOrdValue | ||||
|     {$ENDIF} | ||||
|   ); | ||||
|   {$ELSE} | ||||
|   pSockets := GetObjValue as TIdSocketHandles; | ||||
|   {$ENDIF} | ||||
|   Result := GetListValues(pSockets); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdPropEdBinding.SetValue(const Value: string); | ||||
| var | ||||
|   pSockets: TIdSocketHandles; | ||||
| begin | ||||
|   inherited SetValue(Value); | ||||
|   {$IFNDEF DOTNET} | ||||
|   pSockets := TIdSocketHandles( | ||||
|     {$IFDEF CPU64} | ||||
|     GetInt64Value | ||||
|     {$ELSE} | ||||
|     GetOrdValue | ||||
|     {$ENDIF} | ||||
|   ); | ||||
|   {$ELSE} | ||||
|   pSockets := GetObjValue as TIdSocketHandles; | ||||
|   {$ENDIF} | ||||
|   pSockets.BeginUpdate; | ||||
|   try | ||||
|     FillHandleList(Value, pSockets); | ||||
|   finally | ||||
|     pSockets.EndUpdate; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| { TIdBaseComponentEditor } | ||||
| 
 | ||||
| procedure TIdBaseComponentEditor.ExecuteVerb(Index: Integer); | ||||
| begin | ||||
|   case Index of | ||||
|     0 : TfrmAbout.ShowDlg; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdBaseComponentEditor.GetVerb(Index: Integer): string; | ||||
| begin | ||||
|   case Index of | ||||
|     0: Result := IndyFormat(RSAAboutMenuItemName, [gsIdVersion]); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdBaseComponentEditor.GetVerbCount: Integer; | ||||
| begin | ||||
|   Result := 1; | ||||
| end; | ||||
| 
 | ||||
| procedure Register; | ||||
| begin | ||||
|   RegisterPropertyEditor(TypeInfo(TIdSocketHandles), nil, '', TIdPropEdBinding);    {Do not Localize} | ||||
|   RegisterComponentEditor(TIdBaseComponent, TIdBaseComponentEditor); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdCoreRegister.dcr
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdCoreRegisterCool.dcr
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdCreditsBitmap.res
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdCreditsBitmap.resources
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										1138
									
								
								indy/Core/IdCustomTCPServer.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										253
									
								
								indy/Core/IdCustomTransparentProxy.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,253 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.10    11/12/2004 11:30:16 AM  JPMugaas | ||||
|   Expansions for IPv6. | ||||
| 
 | ||||
|   Rev 1.9    11/11/2004 10:25:22 PM  JPMugaas | ||||
|   Added OpenProxy and CloseProxy so you can do RecvFrom and SendTo functions | ||||
|   from the UDP client with SOCKS.  You must call OpenProxy  before using | ||||
|   RecvFrom or SendTo.  When you are finished, you must use CloseProxy to close | ||||
|   any connection to the Proxy.  Connect and disconnect also call OpenProxy and | ||||
|   CloseProxy. | ||||
| 
 | ||||
|   Rev 1.8    11/11/2004 3:42:52 AM  JPMugaas | ||||
|   Moved strings into RS.  Socks will now raise an exception if you attempt to | ||||
|   use SOCKS4 and SOCKS4A with UDP.  Those protocol versions do not support UDP | ||||
|   at all. | ||||
| 
 | ||||
|   Rev 1.7    11/9/2004 8:18:00 PM  JPMugaas | ||||
|   Attempt to add SOCKS support in UDP. | ||||
| 
 | ||||
|   Rev 1.6    6/6/2004 11:51:56 AM  JPMugaas | ||||
|   Fixed TODO with an exception | ||||
| 
 | ||||
|   Rev 1.5    2004.02.03 4:17:04 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|     Rev 1.4    10/15/2003 10:59:06 PM  DSiders | ||||
|   Corrected spelling error in resource string name. | ||||
|   Added resource string for circular links exception in transparent proxy. | ||||
| 
 | ||||
|     Rev 1.3    10/15/2003 10:10:18 PM  DSiders | ||||
|   Added localization comments. | ||||
| 
 | ||||
|     Rev 1.2    5/16/2003 9:22:38 AM  BGooijen | ||||
|   Added Listen(...) | ||||
| 
 | ||||
|     Rev 1.1    5/14/2003 6:41:00 PM  BGooijen | ||||
|   Added Bind(...) | ||||
| 
 | ||||
|   Rev 1.0    12/2/2002 05:01:26 PM  JPMugaas | ||||
|   Rechecked in due to file corruption. | ||||
| } | ||||
| 
 | ||||
| unit IdCustomTransparentProxy; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //we need to put this in Delphi mode to work | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdComponent, | ||||
|   IdException, | ||||
|   IdGlobal, | ||||
|   IdIOHandler, | ||||
|   IdSocketHandle, | ||||
|   IdBaseComponent; | ||||
| 
 | ||||
| type | ||||
|   EIdTransparentProxyCircularLink = class(EIdException); | ||||
|   EIdTransparentProxyUDPNotSupported = class(EIdException); | ||||
| 
 | ||||
|   TIdCustomTransparentProxyClass = class of TIdCustomTransparentProxy; | ||||
| 
 | ||||
|   TIdCustomTransparentProxy = class(TIdComponent) | ||||
|   protected | ||||
|     FHost: String; | ||||
|     FPassword: String; | ||||
|     FPort: TIdPort; | ||||
|     FIPVersion : TIdIPVersion; | ||||
|     FUsername: String; | ||||
|     {$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FChainedProxy: TIdCustomTransparentProxy; | ||||
|     // | ||||
|     function  GetEnabled: Boolean; virtual; abstract; | ||||
|     procedure SetEnabled(AValue: Boolean); virtual; | ||||
|     procedure MakeConnection(AIOHandler: TIdIOHandler; const AHost: string; const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); virtual; abstract; | ||||
|     {$IFNDEF USE_OBJECT_ARC} | ||||
|     procedure Notification(AComponent: TComponent; Operation: TOperation); override; | ||||
|     {$ENDIF} | ||||
|     procedure SetChainedProxy(const AValue: TIdCustomTransparentProxy); | ||||
|   public | ||||
|     procedure Assign(ASource: TPersistent); override; | ||||
|     procedure OpenUDP(AHandle : TIdSocketHandle; const AHost: string = ''; const APort: TIdPort = 0; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); virtual; | ||||
|     procedure CloseUDP(AHandle: TIdSocketHandle); virtual; | ||||
|     function RecvFromUDP(AHandle: TIdSocketHandle; var ABuffer : TIdBytes; | ||||
|       var VPeerIP: string; var VPeerPort: TIdPort; var VIPVersion: TIdIPVersion; | ||||
|        AMSec: Integer = IdTimeoutDefault): Integer; virtual; | ||||
|     procedure SendToUDP(AHandle: TIdSocketHandle; | ||||
|       const AHost: string; const APort: TIdPort; const AIPVersion: TIdIPVersion; | ||||
|       const ABuffer : TIdBytes); virtual; | ||||
|     procedure Connect(AIOHandler: TIdIOHandler; const AHost: string; const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); | ||||
|     // | ||||
|     procedure Bind(AIOHandler: TIdIOHandler; const AHost: string; const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION);overload;virtual; | ||||
|     procedure Bind(AIOHandler: TIdIOHandler; const APort: TIdPort); overload; | ||||
|     function  Listen(AIOHandler: TIdIOHandler; const ATimeOut: Integer): Boolean; virtual; | ||||
|     // | ||||
|     property  Enabled: Boolean read GetEnabled write SetEnabled; | ||||
|     property  Host: String read FHost write FHost; | ||||
|     property  Password: String read FPassword write FPassword; | ||||
|     property  Port: TIdPort read FPort write FPort; | ||||
|     property  IPVersion : TIdIPVersion read FIPVersion write FIPVersion default ID_DEFAULT_IP_VERSION; | ||||
|     property  Username: String read FUsername write FUsername; | ||||
|     property  ChainedProxy: TIdCustomTransparentProxy read FChainedProxy write SetChainedProxy; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdResourceStringsCore, IdExceptionCore; | ||||
| 
 | ||||
| { TIdCustomTransparentProxy } | ||||
| 
 | ||||
| procedure TIdCustomTransparentProxy.Assign(ASource: TPersistent); | ||||
| var | ||||
|   LSource: TIdCustomTransparentProxy; | ||||
| Begin | ||||
|   if ASource is TIdCustomTransparentProxy then begin | ||||
|     LSource := TIdCustomTransparentProxy(ASource); | ||||
|     FHost := LSource.Host; | ||||
|     FPassword := LSource.Password; | ||||
|     FPort := LSource.Port; | ||||
|     FIPVersion := LSource.IPVersion; | ||||
|     FUsername := LSource.Username; | ||||
|   end else begin | ||||
|     inherited Assign(ASource); | ||||
|   end; | ||||
| End;// | ||||
| 
 | ||||
| procedure TIdCustomTransparentProxy.Connect(AIOHandler: TIdIOHandler; const AHost: string; const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); | ||||
| var | ||||
|   // under ARC, convert a weak reference to a strong reference before working with it | ||||
|   LChainedProxy: TIdCustomTransparentProxy; | ||||
| begin | ||||
|   LChainedProxy := FChainedProxy; | ||||
|   if Assigned(LChainedProxy) and LChainedProxy.Enabled then begin | ||||
|     MakeConnection(AIOHandler, LChainedProxy.Host, LChainedProxy.Port); | ||||
|     LChainedProxy.Connect(AIOHandler, AHost, APort, AIPVersion); | ||||
|   end else begin | ||||
|     MakeConnection(AIOHandler, AHost, APort, AIPVersion); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdCustomTransparentProxy.Listen(AIOHandler: TIdIOHandler; const ATimeOut: integer):boolean; | ||||
| begin | ||||
|   raise EIdTransparentProxyCantBind.Create(RSTransparentProxyCannotBind); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomTransparentProxy.Bind(AIOHandler: TIdIOHandler; const AHost: string; const APort: TIdPort; const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); | ||||
| begin | ||||
|   raise EIdTransparentProxyCantBind.Create(RSTransparentProxyCannotBind); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomTransparentProxy.Bind(AIOHandler: TIdIOHandler; const APort: TIdPort); | ||||
| begin | ||||
|   Bind(AIOHandler, '0.0.0.0', APort);   {do not localize} | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomTransparentProxy.SetEnabled(AValue: Boolean); | ||||
| Begin | ||||
| End; | ||||
| 
 | ||||
| // under ARC, all weak references to a freed object get nil'ed automatically | ||||
| {$IFNDEF USE_OBJECT_ARC} | ||||
| procedure TIdCustomTransparentProxy.Notification(AComponent: TComponent; Operation: TOperation); | ||||
| begin | ||||
|   if (Operation = opRemove) and (AComponent = FChainedProxy) then begin | ||||
|     FChainedProxy := nil; | ||||
|   end; | ||||
|   inherited Notification(AComponent,Operation); | ||||
| end; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| procedure TIdCustomTransparentProxy.SetChainedProxy(const AValue: TIdCustomTransparentProxy); | ||||
| var | ||||
|   LNextValue: TIdCustomTransparentProxy; | ||||
|   // under ARC, convert a weak reference to a strong reference before working with it | ||||
|   LChainedProxy: TIdCustomTransparentProxy; | ||||
| begin | ||||
|   LChainedProxy := FChainedProxy; | ||||
| 
 | ||||
|   if LChainedProxy <> AValue then | ||||
|   begin | ||||
|     LNextValue := AValue; | ||||
|     while Assigned(LNextValue) do begin | ||||
|       if LNextValue = Self then begin | ||||
|         raise EIdTransparentProxyCircularLink.CreateFmt(RSInterceptCircularLink, [ClassName]);// -> One EIDCircularLink exception | ||||
|       end; | ||||
|       LNextValue := LNextValue.ChainedProxy; | ||||
|     end; | ||||
| 
 | ||||
|     // under ARC, all weak references to a freed object get nil'ed automatically | ||||
| 
 | ||||
|     {$IFNDEF USE_OBJECT_ARC} | ||||
|     if Assigned(LChainedProxy) then begin | ||||
|       LChainedProxy.RemoveFreeNotification(Self); | ||||
|     end; | ||||
|     {$ENDIF} | ||||
| 
 | ||||
|     FChainedProxy := AValue; | ||||
| 
 | ||||
|     {$IFNDEF USE_OBJECT_ARC} | ||||
|     if Assigned(AValue) then begin | ||||
|       AValue.FreeNotification(Self); | ||||
|     end; | ||||
|     {$ENDIF} | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomTransparentProxy.CloseUDP(AHandle: TIdSocketHandle); | ||||
| begin | ||||
|   raise EIdTransparentProxyUDPNotSupported.Create(RSTransparentProxyCanNotSupportUDP); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomTransparentProxy.OpenUDP(AHandle: TIdSocketHandle; | ||||
|   const AHost: string = ''; const APort: TIdPort = 0; | ||||
|   const AIPVersion: TIdIPVersion = ID_DEFAULT_IP_VERSION); | ||||
| begin | ||||
|   raise EIdTransparentProxyUDPNotSupported.Create(RSTransparentProxyCanNotSupportUDP); | ||||
| end; | ||||
| 
 | ||||
| function TIdCustomTransparentProxy.RecvFromUDP(AHandle: TIdSocketHandle; | ||||
|   var ABuffer : TIdBytes; var VPeerIP: string; var VPeerPort: TIdPort; | ||||
|   var VIPVersion: TIdIPVersion; AMSec: Integer = IdTimeoutDefault): Integer; | ||||
| begin | ||||
|    raise EIdTransparentProxyUDPNotSupported.Create(RSTransparentProxyCanNotSupportUDP); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomTransparentProxy.SendToUDP(AHandle: TIdSocketHandle; | ||||
|   const AHost: string; const APort: TIdPort; const AIPVersion: TIdIPVersion; | ||||
|   const ABuffer : TIdBytes); | ||||
| begin | ||||
|    raise EIdTransparentProxyUDPNotSupported.Create(RSTransparentProxyCanNotSupportUDP); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
| 
 | ||||
							
								
								
									
										4
									
								
								indy/Core/IdDeprecatedImplBugOff.inc
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,4 @@ | ||||
| {$IFDEF DEPRECATED_IMPL_BUG} | ||||
|   {$WARN SYMBOL_DEPRECATED OFF} | ||||
| {$ENDIF} | ||||
| 
 | ||||
							
								
								
									
										8
									
								
								indy/Core/IdDeprecatedImplBugOn.inc
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,8 @@ | ||||
| {$IFDEF DEPRECATED_IMPL_BUG} | ||||
|   {$IFDEF HAS_DIRECTIVE_WARN_DEFAULT} | ||||
|     {$WARN SYMBOL_DEPRECATED DEFAULT} | ||||
|   {$ELSE} | ||||
|     {$WARN SYMBOL_DEPRECATED ON} | ||||
|   {$ENDIF} | ||||
| {$ENDIF} | ||||
| 
 | ||||
							
								
								
									
										94
									
								
								indy/Core/IdDsnBaseCmpEdt.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,94 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.2    9/5/2004 2:08:16 PM  JPMugaas | ||||
|   Should work in D9 NET. | ||||
| 
 | ||||
|   Rev 1.1    2/3/2004 11:42:50 AM  JPMugaas | ||||
|   Fixed for new design. | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:43:16 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdDsnBaseCmpEdt; | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF DOTNET} | ||||
|   Borland.Vcl.Design.DesignIntF, | ||||
|   Borland.Vcl.Design.DesignEditors | ||||
|   {$ELSE} | ||||
|     {$IFDEF FPC} | ||||
|   ComponentEditors | ||||
|     {$ELSE} | ||||
|       {$IFDEF VCL_6_OR_ABOVE} | ||||
|   DesignIntf, | ||||
|   DesignEditors | ||||
|       {$ELSE} | ||||
|   Dsgnintf | ||||
|       {$ENDIF} | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   ; | ||||
| 
 | ||||
| type | ||||
|   {$IFDEF FPC} | ||||
|   TIdBaseComponentEditor = class(TDefaultComponentEditor) | ||||
|   {$ELSE} | ||||
|   TIdBaseComponentEditor = class(TDefaultEditor) | ||||
|   {$ENDIF} | ||||
|   public | ||||
|     procedure ExecuteVerb(Index: Integer); override; | ||||
|     function GetVerb(Index: Integer): string; override; | ||||
|     function GetVerbCount: Integer; override; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdAbout, | ||||
|   IdGlobal, | ||||
|   IdDsnCoreResourceStrings, | ||||
|   SysUtils; | ||||
| 
 | ||||
| { TIdBaseComponentEditor } | ||||
| 
 | ||||
| procedure TIdBaseComponentEditor.ExecuteVerb(Index: Integer); | ||||
| begin | ||||
|   case Index of | ||||
|     0 : ShowAboutBox(RSAAboutBoxCompName, gsIdVersion); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdBaseComponentEditor.GetVerb(Index: Integer): string; | ||||
| begin | ||||
|   case Index of | ||||
|     0: Result := IndyFormat(RSAAboutMenuItemName, [gsIdVersion]); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdBaseComponentEditor.GetVerbCount: Integer; | ||||
| begin | ||||
|   Result := 1; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
| 
 | ||||
							
								
								
									
										134
									
								
								indy/Core/IdDsnCoreResourceStrings.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,134 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.5    1/29/2004 8:54:30 AM  JPMugaas | ||||
|   Removed myself from the distribution Team Chairperson entry as I am resigning | ||||
|   from that role. | ||||
| 
 | ||||
|   Rev 1.4    10/15/2003 10:11:46 PM  DSiders | ||||
|   Added resource string for About box credits. | ||||
|   Corrected spelling error in comments. | ||||
| 
 | ||||
|   Rev 1.3    6/16/2003 12:01:44 PM  JPMugaas | ||||
|   Updated copyright to say 2003. | ||||
| 
 | ||||
|   Rev 1.2    6/8/2003 05:46:58 AM  JPMugaas | ||||
|   The kitchen sink has now been implemented. | ||||
| 
 | ||||
|   Rev 1.1    1/15/2003 08:03:56 AM  JPMugaas | ||||
|   Updated with new website address. | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:43:24 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdDsnCoreResourceStrings; | ||||
| 
 | ||||
| { | ||||
|   Note:  This unit is for resource strings that are used in the Core Design-Time | ||||
|   package and NOT any design-time packages.  This is to prevent design-time | ||||
|   resource strings from being linked into the Run-Time only package. | ||||
| } | ||||
| 
 | ||||
| interface | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| const | ||||
|   IndyPitCrew = 'Kudzu (Chad Z. Hower)'#13#10 | ||||
|    + 'and the Indy Pit Crew'; | ||||
| 
 | ||||
| resourcestring | ||||
|   { About Box stuff } | ||||
|   RSAAboutFormCaption = 'About'; | ||||
|   RSAAboutBoxCompName = 'Internet Direct (Indy)'; | ||||
|   RSAAboutMenuItemName = 'About Internet &Direct (Indy) %s...'; | ||||
| 
 | ||||
|   RSAAboutBoxVersion = 'Version %s'; | ||||
|   RSAAboutBoxCopyright = 'Copyright (c) 1993 - 2015'#13#10 | ||||
|    + IndyPitCrew; | ||||
|   RSAAboutBoxTitle1 = 'INDY'; | ||||
|   RSAAboutBoxTitle2 = 'Internet Direct'; | ||||
|   RSAAboutBoxLicences = 'Indy Modified BSD License'+#13#10+'Indy MPL License'; | ||||
|   RSAAboutBoxBuiltFor = 'Indy.Sockets (%s)'; | ||||
| 
 | ||||
|   RSAAboutBoxPleaseVisit = 'For the latest updates and information please visit:'; | ||||
|   RSAAboutBoxIndyWebsite = 'http://www.indyproject.org/';    {Do not Localize} | ||||
| 
 | ||||
|   RSAAboutCreditsCoordinator = 'Project Coordinator'; | ||||
|   RSAAboutCreditsCoCordinator = 'Project Co-Coordinator'; | ||||
|   RSAAboutCreditsDocumentation = 'Documentation Coordinator'; | ||||
|   RSAAboutCreditsDemos = 'Demos Coordinator'; | ||||
|   RSAAboutCreditsRetiredPast = 'Retired/Past Contributors'; | ||||
|   RSAAboutCreditsIndyCrew = 'The Indy Pit Crew'; | ||||
| 
 | ||||
|   RSAAboutKitchenSink = IndyPitCrew+#10#13+'present the'#10#13'Kitchen Sink'; | ||||
| 
 | ||||
|   {Binding Editor stuff} | ||||
|   { | ||||
|   Note to translators - Please Read!!! | ||||
| 
 | ||||
|   For all the constants except RSBindingFormCaption, there may be an | ||||
|   & symbol before a letter or number.  This is rendered as that character being | ||||
|   underlined.  In addition, the character after the & symbol along with the ALT | ||||
|   key enables a user to move to that control.  Since these are on one form, be | ||||
|   careful to ensure that the same letter or number does not have a & before it | ||||
|   in more than one string, otherwise an ALT key sequence will be broken. | ||||
|   } | ||||
|   RSBindingFormCaption = 'Binding Editor'; | ||||
|   RSBindingNewCaption  = '&New'; | ||||
|   RSBindingDeleteCaption = '&Delete'; | ||||
|   //RSBindingAddCaption = '&Add'; | ||||
|   RSBindingRemoveCaption = '&Remove'; | ||||
|   RSBindingLabelBindings = '&Bindings'; | ||||
|   RSBindingHostnameLabel = '&IP Address'; | ||||
|   RSBindingPortLabel = '&Port'; | ||||
|   RSBindingIPVerLabel = 'IP &Version'; | ||||
|   RSBindingIPV4Item = 'IPv&4 (127.0.0.1)'; | ||||
|   RSBindingIPV6Item = 'IPv&6 (::1)'; | ||||
|   {Design time SASLList Hints} | ||||
|   RSADlgSLMoveUp = 'Move Up'; | ||||
|   RSADlgSLMoveDown = 'Move Down'; | ||||
|   RSADlgSLAdd = 'Add'; | ||||
|   RSADlgSLRemove = 'Remove'; | ||||
|   //Caption that uses format with component name | ||||
|   RSADlgSLCaption = 'Editing SASL List for %s'; | ||||
|   RSADlgSLAvailable = '&Available'; | ||||
|   RSADlgSLAssigned = 'A&ssigned (tried in order listed)'; | ||||
|   {Note that the Ampersand indicates an ALT keyboard sequence} | ||||
|   RSADlgSLEditList = 'Edit &List'; | ||||
|   //Display item constants | ||||
|   RSBindingAll = 'All'; //all IP addresses | ||||
|   RSBindingAny = 'Any'; //any port | ||||
| 
 | ||||
|   {Standard dialog stock strings} | ||||
|   RSOk       = 'OK'; | ||||
|   RSCancel   = 'Cancel'; | ||||
|   RSHelp     = '&Help'; | ||||
| 
 | ||||
|     // IdRegister | ||||
|   RSRegIndyClients = 'Indy Clients'; | ||||
|   RSRegIndyServers = 'Indy Servers'; | ||||
|   RSRegIndyIntercepts = 'Indy Intercepts'; | ||||
|   RSRegIndyIOHandlers = 'Indy I/O Handlers'; | ||||
|   RSRegIndyMisc = 'Indy Misc'; | ||||
| {$IFDEF FPC} | ||||
|   CoreSuffix = ' - Core'; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										143
									
								
								indy/Core/IdDsnPropEdBinding.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,143 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.9    10/26/2004 8:45:26 PM  JPMugaas | ||||
|   Should compile. | ||||
| 
 | ||||
|   Rev 1.8    10/26/2004 8:42:58 PM  JPMugaas | ||||
|   Should be more portable with new references to TIdStrings and TIdStringList. | ||||
| 
 | ||||
|   Rev 1.7    5/19/2004 10:44:28 PM  DSiders | ||||
|   Corrected spelling for TIdIPAddress.MakeAddressObject method. | ||||
| 
 | ||||
|   Rev 1.6    2/3/2004 11:34:26 AM  JPMugaas | ||||
|   Should compile. | ||||
| 
 | ||||
|   Rev 1.5.1.0    2/3/2004 11:32:26 AM  JPMugaas | ||||
|   Should compile. | ||||
| 
 | ||||
|   Rev 1.5    2/1/2004 2:44:20 AM  JPMugaas | ||||
|   Bindings editor should be fully functional including IPv6 support. | ||||
| 
 | ||||
|   Rev 1.4    2/1/2004 1:03:34 AM  JPMugaas | ||||
|   This now work properly in both Win32 and DotNET.  The behavior had to change | ||||
|   in DotNET because of some missing functionality and because implementing that | ||||
|   functionality creates more problems than it would solve. | ||||
| 
 | ||||
|   Rev 1.3    2003.12.31 10:42:22 PM  czhower | ||||
|   Warning removed | ||||
| 
 | ||||
|   Rev 1.2    10/15/2003 10:12:32 PM  DSiders | ||||
|   Added localization comments. | ||||
| 
 | ||||
|   Rev 1.1    2003.10.11 5:47:46 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:43:58 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdDsnPropEdBinding; | ||||
| 
 | ||||
| { | ||||
|   Design Note:  It turns out that in DotNET, there are no services file functions and | ||||
|   IdPorts does not work as expected in DotNET.  It is probably possible to read the | ||||
|   services file ourselves but that creates some portability problems as the placement | ||||
|  is different in every operating system. | ||||
| 
 | ||||
|   e.g. | ||||
| 
 | ||||
|   Linux and Unix-like systems - /etc | ||||
|   Windows 95, 98, and ME - c:\windows | ||||
|   Windows NT systems - c:\winnt\system32\drivers\etc | ||||
| 
 | ||||
|   Thus, it will undercut whatever benefit we could get with DotNET. | ||||
| 
 | ||||
|   About the best I could think of is to use an edit control because | ||||
|   we can't offer anything from the services file in DotNET. | ||||
| 
 | ||||
|   TODO:  Maybe there might be a way to find the location in a more elegant | ||||
|   manner than what I described. | ||||
| } | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| {$IFDEF WIDGET_WINFORMS} | ||||
| {$R 'IdDsnPropEdBindingNET.TIdDsnPropEdBindingNET.resources' 'IdDsnPropEdBindingNET.resx'} | ||||
| {$ENDIF} | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdSocketHandle; | ||||
| 
 | ||||
| { | ||||
| Design Note:  It turns out that in DotNET, there are no services file functions and IdPorts | ||||
| does not work as expected in DotNET.  It is probably possible to read the services | ||||
| file ourselves but that creates some portability problems as the placement is different | ||||
| in every operating system. | ||||
| 
 | ||||
| e.g. | ||||
| 
 | ||||
| Linux and Unix-like systems - /etc | ||||
| Windows 95, 98, and ME - c:\windows | ||||
| Windows NT systems - c:\winnt\system32\drivers\etc | ||||
| 
 | ||||
| Thus, it will undercut whatever benefit we could get with DotNET. | ||||
| 
 | ||||
| About the best I could think of is to use an edit control because | ||||
| we can't offer anything from the services file in DotNET. | ||||
| 
 | ||||
| TODO:  Maybe there might be a way to find the location in a more eligant | ||||
| manner than what I described. | ||||
| } | ||||
| 
 | ||||
| procedure FillHandleList(const AList: string; ADest: TIdSocketHandles); | ||||
| function GetListValues(const ASocketHandles : TIdSocketHandles) : String; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF WIDGET_WINFORMS} | ||||
|   IdDsnPropEdBindingNET; | ||||
|   {$ELSE} | ||||
|   IdDsnPropEdBindingVCL; | ||||
|   {$ENDIF} | ||||
| 
 | ||||
| procedure FillHandleList(const AList: string; ADest: TIdSocketHandles); | ||||
| begin | ||||
|   {$IFDEF WIDGET_WINFORMS} | ||||
|   IdDsnPropEdBindingNET.FillHandleList(AList,ADest); | ||||
|   {$ELSE} | ||||
|   IdDsnPropEdBindingVCL.FillHandleList(AList,ADest); | ||||
|   {$ENDIF} | ||||
| end; | ||||
| 
 | ||||
| function GetListValues(const ASocketHandles : TIdSocketHandles) : String; | ||||
| begin | ||||
|   {$IFDEF WIDGET_WINFORMS} | ||||
|   Result := IdDsnPropEdBindingNET.GetListValues(ASocketHandles); | ||||
|   {$ELSE} | ||||
|   Result := IdDsnPropEdBindingVCL.GetListValues(ASocketHandles); | ||||
|   {$ENDIF} | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										
											BIN
										
									
								
								indy/Core/IdDsnPropEdBindingNET.TIdDsnPropEdBindingNET.resources
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										702
									
								
								indy/Core/IdDsnPropEdBindingNET.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,702 @@ | ||||
| unit IdDsnPropEdBindingNET; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   System.Drawing, System.Collections, System.ComponentModel, | ||||
|   System.Windows.Forms, System.Data, IdSocketHandle; | ||||
| 
 | ||||
| type | ||||
|   TIdDsnPropEdBindingNET = class(System.Windows.Forms.Form) | ||||
|   {$REGION 'Designer Managed Code'} | ||||
|   strict private | ||||
|     /// <summary> | ||||
|     /// Required designer variable. | ||||
|     /// </summary> | ||||
|     Components: System.ComponentModel.Container; | ||||
|     btnOk: System.Windows.Forms.Button; | ||||
|     btnCancel: System.Windows.Forms.Button; | ||||
|     lblBindings: System.Windows.Forms.Label; | ||||
|     lbBindings: System.Windows.Forms.ListBox; | ||||
|     btnNew: System.Windows.Forms.Button; | ||||
|     btnDelete: System.Windows.Forms.Button; | ||||
|     lblIPAddress: System.Windows.Forms.Label; | ||||
|     edtIPAddress: System.Windows.Forms.ComboBox; | ||||
|     lblPort: System.Windows.Forms.Label; | ||||
|     edtPort: System.Windows.Forms.NumericUpDown; | ||||
|     cboIPVersion: System.Windows.Forms.ComboBox; | ||||
|     lblIPVersion: System.Windows.Forms.Label; | ||||
|     /// <summary> | ||||
|     /// Required method for Designer support - do not modify | ||||
|     /// the contents of this method with the code editor. | ||||
|     /// </summary> | ||||
|     procedure InitializeComponent; | ||||
|     procedure btnNew_Click(sender: System.Object; e: System.EventArgs); | ||||
|     procedure btnDelete_Click(sender: System.Object; e: System.EventArgs); | ||||
|     procedure edtPort_ValueChanged(sender: System.Object; e: System.EventArgs); | ||||
|     procedure edtIPAddress_SelectedValueChanged(sender: System.Object; e: System.EventArgs); | ||||
|     procedure cboIPVersion_SelectedValueChanged(sender: System.Object; e: System.EventArgs); | ||||
|     procedure lbBindings_SelectedValueChanged(sender: System.Object; e: System.EventArgs); | ||||
|   {$ENDREGION} | ||||
|   strict protected | ||||
|     /// <summary> | ||||
|     /// Clean up any resources being used. | ||||
|     /// </summary> | ||||
|     procedure Dispose(Disposing: Boolean); override; | ||||
|   private | ||||
|     FHandles : TIdSocketHandles; | ||||
|     FDefaultPort : Integer; | ||||
|     FIPv4Addresses : TStrings; | ||||
|     FIPv6Addresses : TStrings; | ||||
|     FCurrentHandle : TIdSocketHandle; | ||||
| 
 | ||||
|     { Private Declarations } | ||||
|     procedure SetHandles(const Value: TIdSocketHandles); | ||||
|     procedure SetIPv4Addresses(const Value: TStrings); | ||||
|     procedure SetIPv6Addresses(const Value: TStrings); | ||||
|     procedure UpdateBindingList; | ||||
|     procedure UpdateEditControls; | ||||
|     procedure FillComboBox(ACombo : System.Windows.Forms.ComboBox; AStrings :TStrings); | ||||
|     procedure SetCaption(const AValue : String); | ||||
|     function GetCaption : String; | ||||
|   public | ||||
|     constructor Create; | ||||
|     function Execute : Boolean; | ||||
|     function GetList: string; | ||||
|     procedure SetList(const AList: string); | ||||
|     property Handles : TIdSocketHandles read FHandles write SetHandles; | ||||
|     property DefaultPort : Integer read FDefaultPort write FDefaultPort; | ||||
|     property IPv4Addresses : TStrings read FIPv4Addresses write SetIPv4Addresses; | ||||
|     property IPv6Addresses : TStrings read FIPv6Addresses write SetIPv6Addresses; | ||||
|     property Caption : String read GetCaption write SetCaption; | ||||
|   end; | ||||
| 
 | ||||
|   [assembly: RuntimeRequiredAttribute(TypeOf(TIdDsnPropEdBindingNET))] | ||||
| 
 | ||||
| procedure FillHandleList(const AList: string; ADest: TIdSocketHandles); | ||||
| function GetListValues(const ASocketHandles : TIdSocketHandles) : String; | ||||
| 
 | ||||
| implementation | ||||
| uses | ||||
|   IdGlobal, | ||||
|   IdIPAddress, | ||||
|   IdDsnCoreResourceStrings, IdStack, SysUtils; | ||||
| 
 | ||||
| const | ||||
|   IPv6Wildcard1 = '::';                 {do not localize} | ||||
|   IPv6Wildcard2 = '0:0:0:0:0:0:0:0';    {do not localize} | ||||
|   IPv6Loopback  = '::1';                {do not localize} | ||||
|   IPv4Wildcard  = '0.0.0.0';            {do not localize} | ||||
|   IPv4Loopback  = '127.0.0.1';          {do not localize} | ||||
| 
 | ||||
| function IsValidIP(const AAddr : String): Boolean; | ||||
| var | ||||
|   LIP: TIdIPAddress; | ||||
| begin | ||||
|   LIP :=  TIdIPAddress.MakeAddressObject(AAddr); | ||||
|   Result := Assigned(LIP); | ||||
|   if Result then | ||||
|   begin | ||||
|     FreeAndNil(LIP); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function StripAndSymbol(s : String) : String; | ||||
| begin | ||||
|   Result := ''; | ||||
|   repeat | ||||
|     if s='' then | ||||
|     begin | ||||
|       Break; | ||||
|     end; | ||||
|     Result := Result + Fetch(s,'&'); | ||||
|   until False; | ||||
| end; | ||||
| 
 | ||||
| procedure FillHandleList(const AList: string; ADest: TIdSocketHandles); | ||||
| var | ||||
|   LItems: TStringList; | ||||
|   i: integer; | ||||
|   LIPVersion: TIdIPVersion; | ||||
|   LAddr, LText: string; | ||||
|   LPort: integer; | ||||
| begin | ||||
|   ADest.Clear; | ||||
|   LItems := TStringList.Create; | ||||
|   try | ||||
|     LItems.CommaText := AList; | ||||
|     for i := 0 to LItems.Count-1 do begin | ||||
|       if Length(LItems[i]) > 0 then begin | ||||
|         if TextStartsWith(LItems[i], '[') then begin | ||||
|           //  ipv6 | ||||
|           LIPVersion := Id_IPv6; | ||||
|           LText := Copy(LItems[i], 2, MaxInt); | ||||
|           LAddr := Fetch(LText, ']:'); | ||||
|           LPort := IndyStrToInt(LText, -1); | ||||
|         end else begin | ||||
|           // ipv4 | ||||
|           LIPVersion := Id_IPv4; | ||||
|           LText := LItems[i]; | ||||
|           LAddr := Fetch(LText, ':'); | ||||
|           LPort := IndyStrToInt(LText, -1); | ||||
|           //Note that 0 is legal and indicates the server binds to a random port | ||||
|         end; | ||||
|         if IsValidIP(LAddr) and (LPort > -1) and (LPort < 65536) then begin | ||||
|           with ADest.Add do begin | ||||
|             IPVersion := LIPVersion; | ||||
|             IP := LAddr; | ||||
|             Port := LPort; | ||||
|           end; | ||||
|         end; | ||||
|       end; | ||||
|     end; | ||||
|   finally | ||||
|     LItems.Free; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function NumericOnly(const AText : String) : String; | ||||
| var | ||||
|   i: Integer; | ||||
| begin | ||||
|   Result := ''; | ||||
|   for i := 1 to Length(AText) do | ||||
|   begin | ||||
|     if IsNumeric(AText[i]) then | ||||
|     begin | ||||
|       Result := Result + AText[i]; | ||||
|     end | ||||
|     else | ||||
|     begin | ||||
|       Break; | ||||
|     end; | ||||
|   end; | ||||
|   if (Length(Result) = 0) then | ||||
|   begin | ||||
|     Result := '0'; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function IndexOfNo(const ANo : Integer; AItems : System.Windows.Forms.ComboBox.ObjectCollection) : Integer; | ||||
| begin | ||||
|   for Result := 0 to AItems.Count -1 do | ||||
|   begin | ||||
|     if ANo = IndyStrToInt( NumericOnly(AItems[Result].ToString )) then | ||||
|     begin | ||||
|       Exit; | ||||
|     end; | ||||
|   end; | ||||
|   Result := -1; | ||||
| end; | ||||
| 
 | ||||
| function GetDisplayString(ASocketHandle: TIdSocketHandle): string; | ||||
| begin | ||||
|   Result := ''; | ||||
|   case ASocketHandle.IPVersion of | ||||
|     Id_IPv4 : Result := IndyFormat('%s:%d', [ASocketHandle.IP, ASocketHandle.Port]); | ||||
|     Id_IPv6 : Result := IndyFormat('[%s]:%d', [ASocketHandle.IP, ASocketHandle.Port]); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function GetListValues(const ASocketHandles : TIdSocketHandles) : String; | ||||
| var | ||||
|   i: Integer; | ||||
| begin | ||||
|   Result := ''; | ||||
|   for i := 0 to ASocketHandles.Count -1 do begin | ||||
|     Result := Result + ',' + GetDisplayString(ASocketHandles[i]); | ||||
|   end; | ||||
|   Delete(Result,1,1); | ||||
| end; | ||||
| 
 | ||||
| {$AUTOBOX ON} | ||||
| 
 | ||||
| {$REGION 'Windows Form Designer generated code'} | ||||
| /// <summary> | ||||
| /// Required method for Designer support -- do not modify | ||||
| /// the contents of this method with the code editor. | ||||
| /// </summary> | ||||
| procedure TIdDsnPropEdBindingNET.InitializeComponent; | ||||
| type | ||||
|   TArrayOfInteger = array of Integer; | ||||
| begin | ||||
|   Self.btnOk := System.Windows.Forms.Button.Create; | ||||
|   Self.btnCancel := System.Windows.Forms.Button.Create; | ||||
|   Self.lblBindings := System.Windows.Forms.Label.Create; | ||||
|   Self.lbBindings := System.Windows.Forms.ListBox.Create; | ||||
|   Self.btnNew := System.Windows.Forms.Button.Create; | ||||
|   Self.btnDelete := System.Windows.Forms.Button.Create; | ||||
|   Self.lblIPAddress := System.Windows.Forms.Label.Create; | ||||
|   Self.edtIPAddress := System.Windows.Forms.ComboBox.Create; | ||||
|   Self.lblPort := System.Windows.Forms.Label.Create; | ||||
|   Self.edtPort := System.Windows.Forms.NumericUpDown.Create; | ||||
|   Self.cboIPVersion := System.Windows.Forms.ComboBox.Create; | ||||
|   Self.lblIPVersion := System.Windows.Forms.Label.Create; | ||||
|   (System.ComponentModel.ISupportInitialize(Self.edtPort)).BeginInit; | ||||
|   Self.SuspendLayout; | ||||
|   //  | ||||
|   // btnOk | ||||
|   //  | ||||
|   Self.btnOk.Anchor := (System.Windows.Forms.AnchorStyles((System.Windows.Forms.AnchorStyles.Bottom  | ||||
|     or System.Windows.Forms.AnchorStyles.Right))); | ||||
|   Self.btnOk.DialogResult := System.Windows.Forms.DialogResult.OK; | ||||
|   Self.btnOk.Location := System.Drawing.Point.Create(312, 160); | ||||
|   Self.btnOk.Name := 'btnOk'; | ||||
|   Self.btnOk.TabIndex := 0; | ||||
|   //  | ||||
|   // btnCancel | ||||
|   //  | ||||
|   Self.btnCancel.Anchor := (System.Windows.Forms.AnchorStyles((System.Windows.Forms.AnchorStyles.Bottom  | ||||
|     or System.Windows.Forms.AnchorStyles.Right))); | ||||
|   Self.btnCancel.DialogResult := System.Windows.Forms.DialogResult.Cancel; | ||||
|   Self.btnCancel.Location := System.Drawing.Point.Create(392, 160); | ||||
|   Self.btnCancel.Name := 'btnCancel'; | ||||
|   Self.btnCancel.TabIndex := 1; | ||||
|   //  | ||||
|   // lblBindings | ||||
|   //  | ||||
|   Self.lblBindings.AutoSize := True; | ||||
|   Self.lblBindings.Location := System.Drawing.Point.Create(8, 8); | ||||
|   Self.lblBindings.Name := 'lblBindings'; | ||||
|   Self.lblBindings.Size := System.Drawing.Size.Create(42, 16); | ||||
|   Self.lblBindings.TabIndex := 2; | ||||
|   Self.lblBindings.Text := '&Binding'; | ||||
|   //  | ||||
|   // lbBindings | ||||
|   //  | ||||
|   Self.lbBindings.Anchor := (System.Windows.Forms.AnchorStyles(((System.Windows.Forms.AnchorStyles.Top  | ||||
|     or System.Windows.Forms.AnchorStyles.Bottom) or System.Windows.Forms.AnchorStyles.Left))); | ||||
|   Self.lbBindings.Location := System.Drawing.Point.Create(8, 24); | ||||
|   Self.lbBindings.Name := 'lbBindings'; | ||||
|   Self.lbBindings.Size := System.Drawing.Size.Create(137, 121); | ||||
|   Self.lbBindings.TabIndex := 3; | ||||
|   Include(Self.lbBindings.SelectedValueChanged, Self.lbBindings_SelectedValueChanged); | ||||
|   //  | ||||
|   // btnNew | ||||
|   //  | ||||
|   Self.btnNew.Location := System.Drawing.Point.Create(152, 56); | ||||
|   Self.btnNew.Name := 'btnNew'; | ||||
|   Self.btnNew.TabIndex := 4; | ||||
|   Include(Self.btnNew.Click, Self.btnNew_Click); | ||||
|   //  | ||||
|   // btnDelete | ||||
|   //  | ||||
|   Self.btnDelete.Location := System.Drawing.Point.Create(152, 88); | ||||
|   Self.btnDelete.Name := 'btnDelete'; | ||||
|   Self.btnDelete.TabIndex := 5; | ||||
|   Include(Self.btnDelete.Click, Self.btnDelete_Click); | ||||
|   //  | ||||
|   // lblIPAddress | ||||
|   //  | ||||
|   Self.lblIPAddress.Location := System.Drawing.Point.Create(240, 8); | ||||
|   Self.lblIPAddress.Name := 'lblIPAddress'; | ||||
|   Self.lblIPAddress.Size := System.Drawing.Size.Create(100, 16); | ||||
|   Self.lblIPAddress.TabIndex := 6; | ||||
|   Self.lblIPAddress.Text := 'Label1'; | ||||
|   // | ||||
|   // edtIPAddress | ||||
|   //  | ||||
|   Self.edtIPAddress.Anchor := (System.Windows.Forms.AnchorStyles(((System.Windows.Forms.AnchorStyles.Top  | ||||
|     or System.Windows.Forms.AnchorStyles.Left) or System.Windows.Forms.AnchorStyles.Right))); | ||||
|   Self.edtIPAddress.Location := System.Drawing.Point.Create(240, 24); | ||||
|   Self.edtIPAddress.Name := 'edtIPAddress'; | ||||
|   Self.edtIPAddress.Size := System.Drawing.Size.Create(224, 21); | ||||
|   Self.edtIPAddress.TabIndex := 7; | ||||
|   Include(Self.edtIPAddress.SelectedValueChanged, Self.edtIPAddress_SelectedValueChanged); | ||||
|   //  | ||||
|   // lblPort | ||||
|   //  | ||||
|   Self.lblPort.Location := System.Drawing.Point.Create(240, 58); | ||||
|   Self.lblPort.Name := 'lblPort'; | ||||
|   Self.lblPort.Size := System.Drawing.Size.Create(100, 16); | ||||
|   Self.lblPort.TabIndex := 8; | ||||
|   Self.lblPort.Text := 'Label1'; | ||||
|   //  | ||||
|   // edtPort | ||||
|   //  | ||||
|   Self.edtPort.Anchor := (System.Windows.Forms.AnchorStyles(((System.Windows.Forms.AnchorStyles.Top  | ||||
|     or System.Windows.Forms.AnchorStyles.Left) or System.Windows.Forms.AnchorStyles.Right))); | ||||
|   Self.edtPort.Location := System.Drawing.Point.Create(240, 74); | ||||
|   Self.edtPort.Maximum := System.Decimal.Create(TArrayOfInteger.Create(65535,  | ||||
|           0, 0, 0)); | ||||
|   Self.edtPort.Name := 'edtPort'; | ||||
|   Self.edtPort.Size := System.Drawing.Size.Create(224, 20); | ||||
|   Self.edtPort.TabIndex := 9; | ||||
|   Include(Self.edtPort.ValueChanged, Self.edtPort_ValueChanged); | ||||
|   // | ||||
|   // cboIPVersion | ||||
|   //  | ||||
|   Self.cboIPVersion.DropDownStyle := System.Windows.Forms.ComboBoxStyle.DropDownList; | ||||
|   Self.cboIPVersion.Location := System.Drawing.Point.Create(240, 124); | ||||
|   Self.cboIPVersion.Name := 'cboIPVersion'; | ||||
|   Self.cboIPVersion.Size := System.Drawing.Size.Create(224, 21); | ||||
|   Self.cboIPVersion.TabIndex := 10; | ||||
|   Include(Self.cboIPVersion.SelectedValueChanged, Self.cboIPVersion_SelectedValueChanged); | ||||
|   //  | ||||
|   // lblIPVersion | ||||
|   //  | ||||
|   Self.lblIPVersion.Location := System.Drawing.Point.Create(240, 108); | ||||
|   Self.lblIPVersion.Name := 'lblIPVersion'; | ||||
|   Self.lblIPVersion.Size := System.Drawing.Size.Create(100, 16); | ||||
|   Self.lblIPVersion.TabIndex := 11; | ||||
|   Self.lblIPVersion.Text := 'Label1'; | ||||
|   //  | ||||
|   // TIdDsnPropEdBindingNET | ||||
|   //  | ||||
|   Self.AcceptButton := Self.btnOk; | ||||
|   Self.AutoScaleBaseSize := System.Drawing.Size.Create(5, 13); | ||||
|   Self.CancelButton := Self.btnCancel; | ||||
|   Self.ClientSize := System.Drawing.Size.Create(470, 189); | ||||
|   Self.Controls.Add(Self.lblIPVersion); | ||||
|   Self.Controls.Add(Self.cboIPVersion); | ||||
|   Self.Controls.Add(Self.edtPort); | ||||
|   Self.Controls.Add(Self.lblPort); | ||||
|   Self.Controls.Add(Self.edtIPAddress); | ||||
|   Self.Controls.Add(Self.lblIPAddress); | ||||
|   Self.Controls.Add(Self.btnDelete); | ||||
|   Self.Controls.Add(Self.btnNew); | ||||
|   Self.Controls.Add(Self.lbBindings); | ||||
|   Self.Controls.Add(Self.lblBindings); | ||||
|   Self.Controls.Add(Self.btnCancel); | ||||
|   Self.Controls.Add(Self.btnOk); | ||||
|   Self.FormBorderStyle := System.Windows.Forms.FormBorderStyle.FixedDialog; | ||||
|   Self.MaximizeBox := False; | ||||
|   Self.MaximumSize := System.Drawing.Size.Create(480, 225); | ||||
|   Self.MinimizeBox := False; | ||||
|   Self.MinimumSize := System.Drawing.Size.Create(480, 225); | ||||
|   Self.Name := 'TIdDsnPropEdBindingNET'; | ||||
|   Self.ShowInTaskbar := False; | ||||
|   Self.StartPosition := System.Windows.Forms.FormStartPosition.CenterScreen; | ||||
|   Self.Text := 'WinForm'; | ||||
|   (System.ComponentModel.ISupportInitialize(Self.edtPort)).EndInit; | ||||
|   Self.ResumeLayout(False); | ||||
| end; | ||||
| {$ENDREGION} | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.Dispose(Disposing: Boolean); | ||||
| begin | ||||
|   if Disposing then | ||||
|   begin | ||||
|     if Components <> nil then | ||||
|     begin | ||||
|       Components.Dispose(); | ||||
|       FreeAndNil(FHandles); | ||||
| 
 | ||||
|       FreeAndNil(FIPv4Addresses); | ||||
|       FreeAndNil(FIPv6Addresses); | ||||
| 
 | ||||
|       //don't free FCurrentHandle; - it's in the handles collection | ||||
|       TIdStack.DecUsage; | ||||
|     end; | ||||
|   end; | ||||
|   inherited Dispose(Disposing); | ||||
| 
 | ||||
| end; | ||||
| 
 | ||||
| constructor TIdDsnPropEdBindingNET.Create; | ||||
| var | ||||
|   i: Integer; | ||||
|   LLocalAddresses: TIdStackLocalAddressList; | ||||
| begin | ||||
|   inherited Create; | ||||
|   // | ||||
|   // Required for Windows Form Designer support | ||||
|   // | ||||
|   InitializeComponent; | ||||
|   // | ||||
|   // TODO: Add any constructor code after InitializeComponent call | ||||
|   // | ||||
|   FHandles := TIdSocketHandles.Create(nil); | ||||
|   FIPv4Addresses := TStringList.Create; | ||||
|   FIPv6Addresses := TStringList.Create; | ||||
|   SetIPv4Addresses(nil); | ||||
|   SetIPv6Addresses(nil); | ||||
| 
 | ||||
|   TIdStack.IncUsage; | ||||
|   try | ||||
|     LLocalAddresses := TIdStackLocalAddressList.Create; | ||||
|     try | ||||
|       GStack.GetLocalAddressList(LLocalAddresses); | ||||
|       for i := 0 to LLocalAddresses.Count-1 do | ||||
|       begin | ||||
|         case LLocalAddresses[i].IPVersion of | ||||
|           Id_IPv4: FIPv4Addresses.Add(LLocalAddresses[i].IPAddress); | ||||
|           Id_IPv6: FIPv6Addresses.Add(LLocalAddresses[i].IPAddress); | ||||
|         end; | ||||
|       end; | ||||
|     finally | ||||
|       LLocalAddresses.Free; | ||||
|     end; | ||||
|   finally | ||||
|     TIdStack.DecUsage; | ||||
|   end; | ||||
| 
 | ||||
|   UpdateEditControls; | ||||
|   //captions | ||||
|   btnNew.Text := RSBindingNewCaption; | ||||
|   btnDelete.Text := RSBindingDeleteCaption; | ||||
|   lblIPAddress.Text := RSBindingHostnameLabel; | ||||
|   lblPort.Text := RSBindingPortLabel; | ||||
|   lblIPVersion.Text := RSBindingIPVerLabel; | ||||
|   btnOk.Text := RSOk; | ||||
|   btnCancel.Text := RSCancel; | ||||
|   //IPVersion choices | ||||
|   //we yhave to strip out the & symbol.  In Win32, we use this | ||||
|   //in a radio-box so a user could select by pressingg the 4 or 6 | ||||
|   //key.  For this, we don't have a radio box and I'm too lazy | ||||
|   //to use two Radio Buttons. | ||||
|   cboIPVersion.Items.Add(StripAndSymbol(RSBindingIPV4Item)); | ||||
|   cboIPVersion.Items.Add(StripAndSymbol(RSBindingIPV6Item)); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.SetHandles(const Value: TIdSocketHandles); | ||||
| begin | ||||
|   FHandles.Assign(Value); | ||||
|   UpdateBindingList; | ||||
| end; | ||||
| 
 | ||||
| function TIdDsnPropEdBindingNET.GetList: string; | ||||
| begin | ||||
|   Result := GetListValues(Handles); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.SetIPv6Addresses(const Value: TStrings); | ||||
| begin | ||||
|   if Assigned(Value) then begin | ||||
|     FIPv6Addresses.Assign(Value); | ||||
|   end; | ||||
|   // Ensure that these two are always present | ||||
|   if FIPv6Addresses.IndexOf(IPv6Loopback) = -1 then begin | ||||
|     FIPv6Addresses.Insert(0, IPv6Loopback); | ||||
|   end; | ||||
|   if FIPv6Addresses.IndexOf(IPv6Wildcard1) = -1 then begin | ||||
|     FIPv6Addresses.Insert(0, IPv6Wildcard1); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.SetIPv4Addresses(const Value: TStrings); | ||||
| begin | ||||
|   if Assigned(Value) then begin | ||||
|     FIPv4Addresses.Assign(Value); | ||||
|   end; | ||||
|   // Ensure that these two are always present | ||||
|   if FIPv4Addresses.IndexOf(IPv6Loopback) = -1 then begin | ||||
|     FIPv4Addresses.Insert(0, IPv4Loopback); | ||||
|   end; | ||||
|   if FIPv4Addresses.IndexOf(IPv4Wildcard) = -1 then begin | ||||
|     FIPv4Addresses.Insert(0, IPv4Wildcard); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.SetList(const AList: string); | ||||
| begin | ||||
|   FCurrentHandle := nil; | ||||
|   FillHandleList(AList, Handles); | ||||
|   UpdateBindingList; | ||||
|   UpdateEditControls; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.lbBindings_SelectedValueChanged(sender: System.Object; | ||||
|   e: System.EventArgs); | ||||
| begin | ||||
|   if lbBindings.SelectedIndex >= 0 then begin | ||||
|     btnDelete.Enabled := True; | ||||
|     FCurrentHandle := FHandles[lbBindings.SelectedIndex]; | ||||
|   end else begin | ||||
|     btnDelete.Enabled := False; | ||||
|     FCurrentHandle := nil; | ||||
|   end; | ||||
|   UpdateEditControls; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.cboIPVersion_SelectedValueChanged(sender: System.Object; | ||||
|   e: System.EventArgs); | ||||
| begin | ||||
|   case cboIPVersion.SelectedIndex of | ||||
|     0 : | ||||
|     begin | ||||
|       if FCurrentHandle.IPVersion <> Id_IPv4 then | ||||
|       begin | ||||
|         FCurrentHandle.IPVersion := Id_IPv4; | ||||
|         FillComboBox(edtIPAddress,FIPv4Addresses); | ||||
|         FCurrentHandle.IP := IPv4Wildcard; | ||||
|       end; | ||||
|     end; | ||||
|     1 : | ||||
|     begin | ||||
|       if FCurrentHandle.IPVersion <> Id_IPv6 then | ||||
|       begin | ||||
|         FCurrentHandle.IPVersion := Id_IPv6; | ||||
|         FillComboBox(edtIPAddress,FIPv6Addresses); | ||||
|         FCurrentHandle.IP := IPv6Wildcard1; | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
|   UpdateEditControls; | ||||
|   UpdateBindingList; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.edtIPAddress_SelectedValueChanged(sender: System.Object; | ||||
|   e: System.EventArgs); | ||||
| begin | ||||
|    FCurrentHandle.IP := edtIPAddress.SelectedItem.ToString; | ||||
|   UpdateBindingList; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.edtPort_ValueChanged(sender: System.Object; | ||||
|   e: System.EventArgs); | ||||
| begin | ||||
|   if Assigned(FCurrentHandle) then begin | ||||
|     FCurrentHandle.Port := edtPort.Value.ToInt16(edtPort.Value); | ||||
|   end; | ||||
|   UpdateBindingList; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.btnDelete_Click(sender: System.Object; e: System.EventArgs); | ||||
| var LSH : TIdSocketHandle; | ||||
|   i : Integer; | ||||
| begin | ||||
|   if lbBindings.SelectedIndex >= 0 then | ||||
|   begin | ||||
|     // Delete is not available in D4's collection classes | ||||
|     // This should work just as well. | ||||
|     i := lbBindings.get_SelectedIndex; | ||||
|     LSH := Handles[i]; | ||||
|     FreeAndNil(LSH); | ||||
|     lbBindings.Items.Remove(i); | ||||
|     FCurrentHandle := nil; | ||||
|     UpdateBindingList; | ||||
|   end; | ||||
|   lbBindings_SelectedValueChanged(nil, nil); | ||||
|   UpdateEditControls; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.btnNew_Click(sender: System.Object; e: System.EventArgs); | ||||
| begin | ||||
|   FCurrentHandle := FHandles.Add; | ||||
|   FCurrentHandle.IP := IPv4Wildcard; | ||||
|   FCurrentHandle.Port := FDefaultPort; | ||||
|   UpdateBindingList; | ||||
|   FillComboBox(edtIPAddress, FIPv4Addresses); | ||||
|   UpdateEditControls; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.UpdateBindingList; | ||||
| var | ||||
|   i: integer; | ||||
|   selected: integer; | ||||
|   s: string; | ||||
| begin | ||||
|    selected := lbBindings.SelectedIndex; | ||||
|    lbBindings.BeginUpdate; | ||||
|    try | ||||
|     if lbBindings.Items.Count = FHandles.Count then begin | ||||
|       for i := 0 to FHandles.Count - 1 do begin | ||||
|         s := GetDisplayString(FHandles[i]); | ||||
|         if s <> lbBindings.Items[i].ToString then begin | ||||
|           lbBindings.Items[i] := s; | ||||
|         end; | ||||
|       end; | ||||
|     end else begin | ||||
|       lbBindings.Items.Clear; | ||||
|       for i := 0 to FHandles.Count-1 do begin | ||||
|         lbBindings.Items.Add(GetDisplayString(FHandles[i])); | ||||
|       end; | ||||
|     end; | ||||
|    finally | ||||
|      lbBindings.EndUpdate; | ||||
|      if Assigned(FCurrentHandle) then begin | ||||
|        lbBindings.SelectedIndex := FCurrentHandle.Index; | ||||
|      end else begin | ||||
|        lbBindings.SelectedIndex := IndyMin(selected, lbBindings.Items.Count-1); | ||||
|      end; | ||||
|    end; | ||||
| {  selected := lbBindings.SelectedItem; | ||||
|   lbBindings.Items.BeginUpdate; | ||||
|   try | ||||
|     if lbBindings.Items.Count = FHandles.Count then begin | ||||
|       for i := 0 to FHandles.Count - 1 do begin | ||||
|         s := GetDisplayString(FHandles[i]); | ||||
|         if s <> lbBindings.Items[i] then begin | ||||
|           lbBindings.Items[i] := s; | ||||
|         end; | ||||
|       end; | ||||
|     end else begin | ||||
|       lbBindings.Items.Clear; | ||||
|       for i := 0 to FHandles.Count-1 do begin | ||||
|         lbBindings.Items.Add(GetDisplayString(FHandles[i])); | ||||
|       end; | ||||
|     end; | ||||
|   finally | ||||
|     lbBindings.Items.EndUpdate; | ||||
|     if Assigned(FCurrentHandle) then begin | ||||
|       lbBindings.ItemIndex := FCurrentHandle.Index; | ||||
|     end else begin | ||||
|       lbBindings.ItemIndex := IndyMin(selected, lbBindings.Items.Count-1); | ||||
|     end; | ||||
|   end;      } | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.UpdateEditControls; | ||||
| begin | ||||
|   if Assigned(FCurrentHandle) then | ||||
|   begin | ||||
|     edtPort.Text := ''; | ||||
|     edtPort.Value := FCurrentHandle.Port; | ||||
|     case FCurrentHandle.IPVersion of | ||||
|       Id_IPv4 : | ||||
|       begin | ||||
|         FillComboBox(edtIPAddress, FIPv4Addresses); | ||||
|         edtIPAddress.SelectedItem := edtIPAddress.Items[0]; | ||||
|         cboIPVersion.SelectedItem := cboIPVersion.Items[0]; | ||||
|       end; | ||||
|       Id_IPv6 : | ||||
|       begin | ||||
|         FillComboBox(edtIPAddress, FIPv6Addresses); | ||||
|         edtIPAddress.SelectedItem := edtIPAddress.Items[0]; | ||||
|         cboIPVersion.SelectedItem := cboIPVersion.Items[1]; | ||||
|       end; | ||||
|     end; | ||||
|     if edtIPAddress.DropDownStyle = System.Windows.Forms.ComboBoxStyle.DropDown then begin | ||||
|       edtIPAddress.Text := FCurrentHandle.IP; | ||||
|     end else begin | ||||
|       edtIPAddress.SelectedIndex := edtIPAddress.Items.IndexOf(FCurrentHandle.IP); | ||||
|     end; | ||||
|   end; | ||||
| 
 | ||||
|   lblIPAddress.Enabled := Assigned(FCurrentHandle); | ||||
|   edtIPAddress.Enabled := Assigned(FCurrentHandle); | ||||
|   lblPort.Enabled := Assigned(FCurrentHandle); | ||||
|   edtPort.Enabled := Assigned(FCurrentHandle); | ||||
|   lblIPVersion.Enabled := Assigned(FCurrentHandle); | ||||
|   cboIPVersion.Enabled := Assigned(FCurrentHandle); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.FillComboBox( | ||||
|   ACombo: System.Windows.Forms.ComboBox; AStrings: TStrings); | ||||
| var | ||||
|   i : Integer; | ||||
| begin | ||||
|   ACombo.Items.Clear; | ||||
|    for i := 0 to AStrings.Count-1 do begin | ||||
|      ACombo.Items.Add(AStrings[i]); | ||||
|    end; | ||||
| end; | ||||
| 
 | ||||
| function TIdDsnPropEdBindingNET.Execute: Boolean; | ||||
| begin | ||||
|   Result := Self.ShowDialog = System.Windows.Forms.DialogResult.OK; | ||||
| end; | ||||
| 
 | ||||
| function TIdDsnPropEdBindingNET.GetCaption: String; | ||||
| begin | ||||
|   Result := Text; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingNET.SetCaption(const AValue: String); | ||||
| begin | ||||
|   Text := AValue; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										196
									
								
								indy/Core/IdDsnPropEdBindingNET.resx
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,196 @@ | ||||
| <?xml version="1.0" encoding="utf-8"?> | ||||
| <root> | ||||
|   <!--  | ||||
|     Microsoft ResX Schema  | ||||
|      | ||||
|     Version 1.3 | ||||
|      | ||||
|     The primary goals of this format is to allow a simple XML format  | ||||
|     that is mostly human readable. The generation and parsing of the  | ||||
|     various data types are done through the TypeConverter classes  | ||||
|     associated with the data types. | ||||
|      | ||||
|     Example: | ||||
|      | ||||
|     ... ado.net/XML headers & schema ... | ||||
|     <resheader name="resmimetype">text/microsoft-resx</resheader> | ||||
|     <resheader name="version">1.3</resheader> | ||||
|     <resheader name="reader">System.Resources.ResXResourceReader, System.Windows.Forms, ...</resheader> | ||||
|     <resheader name="writer">System.Resources.ResXResourceWriter, System.Windows.Forms, ...</resheader> | ||||
|     <data name="Name1">this is my long string</data> | ||||
|     <data name="Color1" type="System.Drawing.Color, System.Drawing">Blue</data> | ||||
|     <data name="Bitmap1" mimetype="application/x-microsoft.net.object.binary.base64"> | ||||
|         [base64 mime encoded serialized .NET Framework object] | ||||
|     </data> | ||||
|     <data name="Icon1" type="System.Drawing.Icon, System.Drawing" mimetype="application/x-microsoft.net.object.bytearray.base64"> | ||||
|         [base64 mime encoded string representing a byte array form of the .NET Framework object] | ||||
|     </data> | ||||
|                  | ||||
|     There are any number of "resheader" rows that contain simple  | ||||
|     name/value pairs. | ||||
|      | ||||
|     Each data row contains a name, and value. The row also contains a  | ||||
|     type or mimetype. Type corresponds to a .NET class that support  | ||||
|     text/value conversion through the TypeConverter architecture.  | ||||
|     Classes that don't support this are serialized and stored with the  | ||||
|     mimetype set. | ||||
|      | ||||
|     The mimetype is used forserialized objects, and tells the  | ||||
|     ResXResourceReader how to depersist the object. This is currently not  | ||||
|     extensible. For a given mimetype the value must be set accordingly: | ||||
|      | ||||
|     Note - application/x-microsoft.net.object.binary.base64 is the format  | ||||
|     that the ResXResourceWriter will generate, however the reader can  | ||||
|     read any of the formats listed below. | ||||
|      | ||||
|     mimetype: application/x-microsoft.net.object.binary.base64 | ||||
|     value   : The object must be serialized with  | ||||
|             : System.Serialization.Formatters.Binary.BinaryFormatter | ||||
|             : and then encoded with base64 encoding. | ||||
|      | ||||
|     mimetype: application/x-microsoft.net.object.soap.base64 | ||||
|     value   : The object must be serialized with  | ||||
|             : System.Runtime.Serialization.Formatters.Soap.SoapFormatter | ||||
|             : and then encoded with base64 encoding. | ||||
| 
 | ||||
|     mimetype: application/x-microsoft.net.object.bytearray.base64 | ||||
|     value   : The object must be serialized into a byte array  | ||||
|             : using a System.ComponentModel.TypeConverter | ||||
|             : and then encoded with base64 encoding. | ||||
|     --> | ||||
|   <xsd:schema id="root" xmlns="" xmlns:xsd="http://www.w3.org/2001/XMLSchema" xmlns:msdata="urn:schemas-microsoft-com:xml-msdata"> | ||||
|     <xsd:element name="root" msdata:IsDataSet="true"> | ||||
|       <xsd:complexType> | ||||
|         <xsd:choice maxOccurs="unbounded"> | ||||
|           <xsd:element name="data"> | ||||
|             <xsd:complexType> | ||||
|               <xsd:sequence> | ||||
|                 <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> | ||||
|                 <xsd:element name="comment" type="xsd:string" minOccurs="0" msdata:Ordinal="2" /> | ||||
|               </xsd:sequence> | ||||
|               <xsd:attribute name="name" type="xsd:string" msdata:Ordinal="1" /> | ||||
|               <xsd:attribute name="type" type="xsd:string" msdata:Ordinal="3" /> | ||||
|               <xsd:attribute name="mimetype" type="xsd:string" msdata:Ordinal="4" /> | ||||
|             </xsd:complexType> | ||||
|           </xsd:element> | ||||
|           <xsd:element name="resheader"> | ||||
|             <xsd:complexType> | ||||
|               <xsd:sequence> | ||||
|                 <xsd:element name="value" type="xsd:string" minOccurs="0" msdata:Ordinal="1" /> | ||||
|               </xsd:sequence> | ||||
|               <xsd:attribute name="name" type="xsd:string" use="required" /> | ||||
|             </xsd:complexType> | ||||
|           </xsd:element> | ||||
|         </xsd:choice> | ||||
|       </xsd:complexType> | ||||
|     </xsd:element> | ||||
|   </xsd:schema> | ||||
|   <resheader name="resmimetype"> | ||||
|     <value>text/microsoft-resx</value> | ||||
|   </resheader> | ||||
|   <resheader name="version"> | ||||
|     <value>1.3</value> | ||||
|   </resheader> | ||||
|   <resheader name="reader"> | ||||
|     <value>System.Resources.ResXResourceReader, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> | ||||
|   </resheader> | ||||
|   <resheader name="writer"> | ||||
|     <value>System.Resources.ResXResourceWriter, System.Windows.Forms, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089</value> | ||||
|   </resheader> | ||||
|   <data name="btnOk.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="btnOk.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="btnCancel.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="btnCancel.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblBindings.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblBindings.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lbBindings.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lbBindings.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="btnNew.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="btnNew.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="btnDelete.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="btnDelete.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblIPAddress.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblIPAddress.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="edtIPAddress.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="edtIPAddress.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblPort.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblPort.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="edtPort.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="edtPort.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="cboIPVersion.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="cboIPVersion.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="lblIPVersion.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="lblIPVersion.Modifiers" type="System.CodeDom.MemberAttributes, System, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>Private</value> | ||||
|   </data> | ||||
|   <data name="$this.Locked" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.Language" type="System.Globalization.CultureInfo, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>(Default)</value> | ||||
|   </data> | ||||
|   <data name="$this.TrayLargeIcon" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.Localizable" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>False</value> | ||||
|   </data> | ||||
|   <data name="$this.GridSize" type="System.Drawing.Size, System.Drawing, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b03f5f7f11d50a3a"> | ||||
|     <value>8, 8</value> | ||||
|   </data> | ||||
|   <data name="$this.DrawGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>True</value> | ||||
|   </data> | ||||
|   <data name="$this.TrayHeight" type="System.Int32, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>80</value> | ||||
|   </data> | ||||
|   <data name="$this.SnapToGrid" type="System.Boolean, mscorlib, Version=1.0.5000.0, Culture=neutral, PublicKeyToken=b77a5c561934e089"> | ||||
|     <value>True</value> | ||||
|   </data> | ||||
| </root> | ||||
							
								
								
									
										819
									
								
								indy/Core/IdDsnPropEdBindingVCL.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,819 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.9    10/26/2004 8:45:26 PM  JPMugaas | ||||
|   Should compile. | ||||
| 
 | ||||
|   Rev 1.8    10/26/2004 8:42:58 PM  JPMugaas | ||||
|   Should be more portable with new references to TIdStrings and TIdStringList. | ||||
| 
 | ||||
|   Rev 1.7    5/19/2004 10:44:28 PM  DSiders | ||||
|   Corrected spelling for TIdIPAddress.MakeAddressObject method. | ||||
| 
 | ||||
|   Rev 1.6    2/3/2004 11:34:26 AM  JPMugaas | ||||
|   Should compile. | ||||
| 
 | ||||
|   Rev 1.5.1.0    2/3/2004 11:32:26 AM  JPMugaas | ||||
|   Should compile. | ||||
| 
 | ||||
|   Rev 1.5    2/1/2004 2:44:20 AM  JPMugaas | ||||
|   Bindings editor should be fully functional including IPv6 support. | ||||
| 
 | ||||
|   Rev 1.4    2/1/2004 1:03:34 AM  JPMugaas | ||||
|   This now work properly in both Win32 and DotNET.  The behavior had to change | ||||
|   in DotNET because of some missing functionality and because implementing that | ||||
|   functionality creates more problems than it would solve. | ||||
| 
 | ||||
|   Rev 1.3    2003.12.31 10:42:22 PM  czhower | ||||
|   Warning removed | ||||
| 
 | ||||
|   Rev 1.2    10/15/2003 10:12:32 PM  DSiders | ||||
|   Added localization comments. | ||||
| 
 | ||||
|   Rev 1.1    2003.10.11 5:47:46 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:43:58 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdDsnPropEdBindingVCL; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
| {$IFDEF WIDGET_KYLIX} | ||||
|   QActnList, QStdCtrls, QForms, QExtCtrls, QControls, QComCtrls, QGraphics, Qt, | ||||
| {$ENDIF} | ||||
| {$IFDEF WIDGET_VCL_LIKE} | ||||
|   ActnList, StdCtrls, Buttons, ExtCtrls, Graphics, Controls, ComCtrls, Forms, Dialogs, | ||||
| {$ENDIF} | ||||
| {$IFDEF HAS_UNIT_Types} | ||||
|   Types, | ||||
| {$ENDIF} | ||||
| {$IFDEF WINDOWS} | ||||
|   Windows, | ||||
| {$ENDIF} | ||||
| {$IFDEF LCL} | ||||
|   LResources, | ||||
| {$ENDIF} | ||||
|   IdSocketHandle; | ||||
| { | ||||
|   Design Note:  It turns out that in DotNET, there are no services file functions and | ||||
|   IdPorts does not work as expected in DotNET.  It is probably possible to read the | ||||
|   services file ourselves but that creates some portability problems as the placement | ||||
|   is different in every operating system. | ||||
| 
 | ||||
|   e.g. | ||||
| 
 | ||||
|   Linux and Unix-like systems - /etc | ||||
|   Windows 95, 98, and ME - c:\windows | ||||
|   Windows NT systems - c:\winnt\system32\drivers\etc | ||||
| 
 | ||||
|   Thus, it will undercut whatever benefit we could get with DotNET. | ||||
| 
 | ||||
|   About the best I could think of is to use an edit control because | ||||
|   we can't offer anything from the services file in DotNET. | ||||
| 
 | ||||
|   TODO:  Maybe there might be a way to find the location in a more elegant | ||||
|   manner than what I described. | ||||
| } | ||||
| 
 | ||||
| type | ||||
|   TIdDsnPropEdBindingVCL = class(TForm) | ||||
|    {$IFDEF USE_TBitBtn} | ||||
|     btnOk: TBitBtn; | ||||
|     btnCancel: TBitBtn; | ||||
|   {$ELSE} | ||||
|     btnOk: TButton; | ||||
|     btnCancel: TButton; | ||||
|   {$ENDIF} | ||||
|     lblBindings: TLabel; | ||||
|     edtPort: TComboBox; | ||||
|     rdoBindingType: TRadioGroup; | ||||
|     lblIPAddress: TLabel; | ||||
|     lblPort: TLabel; | ||||
|     btnNew: TButton; | ||||
|     btnDelete: TButton; | ||||
|     ActionList1: TActionList; | ||||
|     btnBindingsNew: TAction; | ||||
|     btnBindingsDelete: TAction; | ||||
|     edtIPAddress: TComboBox; | ||||
|     lbBindings: TListBox; | ||||
|     procedure btnBindingsNewExecute(Sender: TObject); | ||||
|     procedure btnBindingsDeleteExecute(Sender: TObject); | ||||
|     procedure btnBindingsDeleteUpdate(Sender: TObject); | ||||
|     procedure edtPortKeyPress(Sender: TObject; var Key: Char); | ||||
|     procedure edtIPAddressChange(Sender: TObject); | ||||
|     procedure edtPortChange(Sender: TObject); | ||||
|     procedure rdoBindingTypeClick(Sender: TObject); | ||||
|     procedure lbBindingsClick(Sender: TObject); | ||||
|   private | ||||
|     procedure SetHandles(const Value: TIdSocketHandles); | ||||
|     procedure SetIPv4Addresses(const Value: TStrings); | ||||
|     procedure SetIPv6Addresses(const Value: TStrings); | ||||
|     procedure UpdateBindingList; | ||||
|   protected | ||||
|     FInUpdateRoutine : Boolean; | ||||
|     FHandles : TIdSocketHandles; | ||||
|     FDefaultPort : Integer; | ||||
|     FIPv4Addresses : TStrings; | ||||
|     FIPv6Addresses : TStrings; | ||||
|     fCreatedStack : Boolean; | ||||
|     FCurrentHandle : TIdSocketHandle; | ||||
|     procedure UpdateEditControls; | ||||
|     function PortDescription(const PortNumber: integer): string; | ||||
|   public | ||||
|     Constructor Create(AOwner : TComponent); overload; override; | ||||
|     constructor Create; reintroduce; overload; | ||||
|     Destructor Destroy; override; | ||||
|     function Execute : Boolean; | ||||
|     function GetList: string; | ||||
|     procedure SetList(const AList: string); | ||||
|     property Handles : TIdSocketHandles read FHandles write SetHandles; | ||||
|     property DefaultPort : Integer read FDefaultPort write FDefaultPort; | ||||
|     property IPv4Addresses : TStrings read FIPv4Addresses write SetIPv4Addresses; | ||||
|     property IPv6Addresses : TStrings read FIPv6Addresses write SetIPv6Addresses; | ||||
|   end; | ||||
| 
 | ||||
| var | ||||
|   IdPropEdBindingEntry: TIdDsnPropEdBindingVCL; | ||||
| 
 | ||||
| procedure FillHandleList(const AList: string; ADest: TIdSocketHandles); | ||||
| function GetListValues(const ASocketHandles : TIdSocketHandles) : String; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdGlobal, | ||||
|   IdIPAddress, | ||||
|   IdDsnCoreResourceStrings, | ||||
|   IdStack, | ||||
|   IdStackBSDBase, | ||||
|   SysUtils; | ||||
| 
 | ||||
| const | ||||
|   IPv6Wildcard1 = '::';                 {do not localize} | ||||
|   {CH IPv6Wildcard2 = '0:0:0:0:0:0:0:0'; }    {do not localize} | ||||
|   IPv6Loopback  = '::1';                {do not localize} | ||||
|   IPv4Wildcard  = '0.0.0.0';            {do not localize} | ||||
|   IPv4Loopback  = '127.0.0.1';          {do not localize} | ||||
| 
 | ||||
| function IsValidIP(const AAddr : String): Boolean; | ||||
| var | ||||
|   LIP : TIdIPAddress; | ||||
| begin | ||||
|   LIP := TIdIPAddress.MakeAddressObject(AAddr); | ||||
|   Result := Assigned(LIP); | ||||
|   if Result then begin | ||||
|     FreeAndNil(LIP); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure FillHandleList(const AList: string; ADest: TIdSocketHandles); | ||||
| var | ||||
|   LItems: TStringList; | ||||
|   i: integer; | ||||
|   LIPVersion: TIdIPVersion; | ||||
|   LAddr, LText: string; | ||||
|   LPort: integer; | ||||
|   LSocket: TIdSocketHandle; | ||||
| begin | ||||
|   ADest.Clear; | ||||
|   LItems := TStringList.Create; | ||||
|   try | ||||
|     LItems.CommaText := AList; | ||||
|     for i := 0 to LItems.Count-1 do begin | ||||
|       if Length(LItems[i]) > 0 then begin | ||||
|         if TextStartsWith(LItems[i], '[') then begin | ||||
|          //  ipv6 | ||||
|           LIPVersion := Id_IPv6; | ||||
|           LText := Copy(LItems[i], 2, MaxInt); | ||||
|           LAddr := Fetch(LText, ']:'); | ||||
|           LPort := StrToIntDef(LText, -1); | ||||
|         end else begin | ||||
|           // ipv4 | ||||
|           LIPVersion := Id_IPv4; | ||||
|           LText := LItems[i]; | ||||
|           LAddr := Fetch(LText, ':'); | ||||
|           LPort := StrToIntDef(LText, -1); | ||||
|           //Note that 0 is legal and indicates the server binds to a random port | ||||
|         end; | ||||
|         if IsValidIP(LAddr) and (LPort > -1) and (LPort < 65536) then begin | ||||
|           LSocket := ADest.Add; | ||||
|           LSocket.IPVersion := LIPVersion; | ||||
|           LSocket.IP := LAddr; | ||||
|           LSocket.Port := LPort; | ||||
|         end; | ||||
|       end; | ||||
|     end; | ||||
|   finally | ||||
|     LItems.Free; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| { TIdDsnPropEdBindingVCL } | ||||
| 
 | ||||
| function NumericOnly(const AText : String) : String; | ||||
| var | ||||
|   i : Integer; | ||||
| begin | ||||
|   Result := ''; | ||||
|   for i := 1 to Length(AText) do | ||||
|   begin | ||||
|     if IsNumeric(AText[i]) then begin | ||||
|       Result := Result + AText[i]; | ||||
|     end else begin | ||||
|       Break; | ||||
|     end; | ||||
|   end; | ||||
|   if Length(Result) = 0 then begin | ||||
|     Result := '0'; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function IndexOfNo(const ANo : Integer; AStrings : TStrings) : Integer; | ||||
| begin | ||||
|   for Result := 0 to AStrings.Count-1 do | ||||
|   begin | ||||
|     if ANo = IndyStrToInt(NumericOnly(AStrings[Result])) then begin | ||||
|       Exit; | ||||
|     end; | ||||
|   end; | ||||
|   Result := -1; | ||||
| end; | ||||
| 
 | ||||
| function GetDisplayString(ASocketHandle: TIdSocketHandle): string; | ||||
| begin | ||||
|   Result := ''; | ||||
|   case ASocketHandle.IPVersion of | ||||
|     Id_IPv4 : Result := Format('%s:%d',[ASocketHandle.IP, ASocketHandle.Port]); | ||||
|     Id_IPv6 : Result := Format('[%s]:%d',[ASocketHandle.IP, ASocketHandle.Port]); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function GetListValues(const ASocketHandles : TIdSocketHandles) : String; | ||||
| var i : Integer; | ||||
| begin | ||||
|   Result := ''; | ||||
|   for i := 0 to ASocketHandles.Count -1 do begin | ||||
|     Result := Result + ',' + GetDisplayString(ASocketHandles[i]); | ||||
|   end; | ||||
|   Delete(Result,1,1); | ||||
| end; | ||||
| 
 | ||||
| constructor TIdDsnPropEdBindingVCL.Create(AOwner: TComponent); | ||||
| var | ||||
|   i : Integer; | ||||
|   LLocalAddresses: TIdStackLocalAddressList; | ||||
| begin | ||||
|   inherited CreateNew(AOwner, 0); | ||||
|   {$IFNDEF WIDGET_KYLIX} | ||||
|   Borderstyle := bsDialog; | ||||
|   {$ENDIF} | ||||
|   BorderIcons := [biSystemMenu]; | ||||
|  // Width := 480; | ||||
|  // Height := 252; | ||||
|   ClientWidth  := 472; | ||||
|   {$IFDEF USE_TBitBtn} | ||||
|   ClientHeight := 230; | ||||
|   {$ELSE} | ||||
|   ClientHeight := 225; | ||||
|   {$ENDIF} | ||||
|   Constraints.MaxWidth := Width; | ||||
|   Constraints.MaxHeight := Height; | ||||
|   Constraints.MinWidth := Width; | ||||
|   Constraints.MinHeight := Height; | ||||
|   Position := poScreenCenter; | ||||
|   lblBindings := TLabel.Create(Self); | ||||
|   lbBindings := TListBox.Create(Self); | ||||
|   ActionList1 := TActionList.Create(Self); | ||||
|   btnBindingsNew := TAction.Create(Self); | ||||
|   btnBindingsDelete := TAction.Create(Self); | ||||
|   btnNew := TButton.Create(Self); | ||||
|   btnDelete := TButton.Create(Self); | ||||
|   lblIPAddress := TLabel.Create(Self); | ||||
|   edtIPAddress := TComboBox.Create(Self); | ||||
|   lblPort := TLabel.Create(Self); | ||||
| 
 | ||||
|   edtPort := TComboBox.Create(Self); | ||||
|   rdoBindingType := TRadioGroup.Create(Self); | ||||
| 
 | ||||
|   {$IFDEF USE_TBitBtn} | ||||
|   btnOk := TBitBtn.Create(Self); | ||||
|   btnCancel := TBitBtn.Create(Self); | ||||
|   {$ELSE} | ||||
|   btnOk := TButton.Create(Self); | ||||
|   btnCancel := TButton.Create(Self); | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   lblBindings.Name := 'lblBindings';  {do not localize} | ||||
|   lblBindings.Parent := Self; | ||||
|   lblBindings.Left := 8; | ||||
|   lblBindings.Top := 8; | ||||
|   lblBindings.Width := 35; | ||||
|   lblBindings.Height := 13; | ||||
|   lblBindings.Caption := '&Binding';  {do not localize} | ||||
| 
 | ||||
|   lbBindings.Name := 'lbBindings';   {do not localize} | ||||
|   lbBindings.Parent := Self; | ||||
|   lbBindings.Left := 8; | ||||
|   lbBindings.Top := 24; | ||||
|   lbBindings.Width := 137; | ||||
|   lbBindings.Height := 161; | ||||
|   lbBindings.ItemHeight := 13; | ||||
|   lbBindings.TabOrder := 8; | ||||
|   lbBindings.OnClick := lbBindingsClick; | ||||
| 
 | ||||
|   ActionList1.Name := 'ActionList1';  {do not localize} | ||||
|   { | ||||
|   ActionList1.Left := 152; | ||||
|   ActionList1.Top := 32; | ||||
|   } | ||||
| 
 | ||||
|   btnBindingsNew.Name := 'btnBindingsNew'; {do not localize} | ||||
|   btnBindingsNew.Caption := RSBindingNewCaption; | ||||
|   btnBindingsNew.OnExecute := btnBindingsNewExecute; | ||||
| 
 | ||||
|   btnBindingsDelete.Name := 'btnBindingsDelete';  {do not localize} | ||||
|   btnBindingsDelete.Caption := RSBindingDeleteCaption; | ||||
|   btnBindingsDelete.OnExecute := btnBindingsDeleteExecute; | ||||
|   btnBindingsDelete.OnUpdate := btnBindingsDeleteUpdate; | ||||
| 
 | ||||
|   btnNew.Name := 'btnNew'; {do not localize} | ||||
|   btnNew.Parent := Self; | ||||
|   btnNew.Left := 152; | ||||
|   btnNew.Top := 72; | ||||
|   btnNew.Width := 75; | ||||
|   btnNew.Height := 25; | ||||
|   btnNew.Action := btnBindingsNew; | ||||
|   btnNew.TabOrder := 6; | ||||
| 
 | ||||
|   btnDelete.Name := 'btnDelete';  {do not localize} | ||||
|   btnDelete.Parent := Self; | ||||
|   btnDelete.Left := 152; | ||||
|   btnDelete.Top := 104; | ||||
|   btnDelete.Width := 75; | ||||
|   btnDelete.Height := 25; | ||||
|   btnDelete.Action := btnBindingsDelete; | ||||
|   btnDelete.TabOrder := 7; | ||||
| 
 | ||||
|   lblIPAddress.Name := 'lblIPAddress'; {do not localize} | ||||
|   lblIPAddress.Parent := Self; | ||||
|   lblIPAddress.Left := 240; | ||||
|   lblIPAddress.Top := 8; | ||||
|   lblIPAddress.Width := 54; | ||||
|   lblIPAddress.Height := 13; | ||||
|   lblIPAddress.Caption := RSBindingHostnameLabel; | ||||
|   lblIPAddress.Enabled := False; | ||||
| 
 | ||||
|   edtIPAddress.Name := 'edtIPAddress'; {do not localize} | ||||
|   edtIPAddress.Parent := Self; | ||||
|   edtIPAddress.Left := 240; | ||||
|   edtIPAddress.Top := 24; | ||||
|   edtIPAddress.Width := 221; | ||||
|   edtIPAddress.Height := 21; | ||||
|   edtIPAddress.Enabled := False; | ||||
|   edtIPAddress.ItemHeight := 13; | ||||
|   edtIPAddress.TabOrder := 3; | ||||
|   edtIPAddress.OnChange := edtIPAddressChange; | ||||
| 
 | ||||
|   lblPort.Name := 'lblPort';  {do not localize} | ||||
|   lblPort.Parent := Self; | ||||
|   lblPort.Left := 240; | ||||
|   lblPort.Top := 56; | ||||
|   lblPort.Width := 22; | ||||
|   lblPort.Height := 13; | ||||
|   lblPort.Caption := RSBindingPortLabel; | ||||
|   lblPort.Enabled := False; | ||||
|   lblPort.FocusControl := edtPort; | ||||
| 
 | ||||
|   edtPort.Name := 'edtPort';  {do not localize} | ||||
|   edtPort.Parent := Self; | ||||
|   edtPort.Left := 240; | ||||
|   edtPort.Top := 72; | ||||
|   edtPort.Width := 221; | ||||
|   edtPort.Height := 21; | ||||
|   edtPort.Enabled := False; | ||||
|   edtPort.ItemHeight := 13; | ||||
|   edtPort.TabOrder := 4; | ||||
|   edtPort.OnChange := edtPortChange; | ||||
|   edtPort.OnKeyPress := edtPortKeyPress; | ||||
| 
 | ||||
|   rdoBindingType.Name := 'rdoBindingType'; {do not localize} | ||||
|   rdoBindingType.Parent := Self; | ||||
|   rdoBindingType.Left := 240; | ||||
|   rdoBindingType.Top := 120; | ||||
|   rdoBindingType.Width := 221; | ||||
|   rdoBindingType.Height := 65; | ||||
|   rdoBindingType.Caption := RSBindingIPVerLabel; | ||||
|   rdoBindingType.Enabled := False; | ||||
|   rdoBindingType.Items.Add(RSBindingIPV4Item); | ||||
|   rdoBindingType.Items.Add(RSBindingIPV6Item); | ||||
|   rdoBindingType.TabOrder := 5; | ||||
|   rdoBindingType.OnClick := rdoBindingTypeClick; | ||||
| 
 | ||||
|   btnOk.Name := 'btnOk';  {do not localize} | ||||
|   btnOk.Parent := Self; | ||||
|   btnOk.Anchors := [akRight, akBottom]; | ||||
|   btnOk.Left := 306; | ||||
|   btnOk.Top := 193; | ||||
|   btnOk.Width := 75; | ||||
|   {$IFDEF USE_TBitBtn} | ||||
|   btnOk.Height := 30; | ||||
|   btnOk.Kind := bkOk; | ||||
|   {$ELSE} | ||||
|   btnOk.Height := 25; | ||||
|   btnOk.Caption := RSOk; | ||||
|   btnOk.Default := True; | ||||
|   btnOk.ModalResult := 1; | ||||
|   {$ENDIF} | ||||
|   btnOk.TabOrder := 0; | ||||
| 
 | ||||
|   btnCancel.Name := 'btnCancel';  {do not localize} | ||||
|   btnCancel.Parent := Self; | ||||
|   btnCancel.Anchors := [akRight, akBottom]; | ||||
|   btnCancel.Left := 386; | ||||
|   btnCancel.Top := 193; | ||||
|   btnCancel.Width := 75; | ||||
|   {$IFDEF USE_TBitBtn} | ||||
|   btnCancel.Height := 30; | ||||
|   btnCancel.Kind := bkCancel; | ||||
|   {$ELSE} | ||||
|   btnCancel.Height := 25; | ||||
|   btnCancel.Cancel := True; | ||||
|   btnCancel.Caption := RSCancel; | ||||
|   btnCancel.ModalResult := 2; | ||||
|   {$ENDIF} | ||||
|   btnCancel.Anchors := [akRight, akBottom]; | ||||
|   btnCancel.TabOrder := 1; | ||||
| 
 | ||||
|   FHandles := TIdSocketHandles.Create(nil); | ||||
|   FIPv4Addresses := TStringList.Create; | ||||
|   FIPv6Addresses := TStringList.Create; | ||||
|   SetIPv4Addresses(nil); | ||||
|   SetIPv6Addresses(nil); | ||||
| 
 | ||||
|   TIdStack.IncUsage; | ||||
|   try | ||||
|     LLocalAddresses := TIdStackLocalAddressList.Create; | ||||
|     try | ||||
|       GStack.GetLocalAddressList(LLocalAddresses); | ||||
|       for i := 0 to LLocalAddresses.Count-1 do | ||||
|       begin | ||||
|         case LLocalAddresses[i].IPVersion of | ||||
|           Id_IPv4: FIPv4Addresses.Add(LLocalAddresses[i].IPAddress); | ||||
|           Id_IPv6: FIPv6Addresses.Add(LLocalAddresses[i].IPAddress); | ||||
|         end; | ||||
|       end; | ||||
|     finally | ||||
|       LLocalAddresses.Free; | ||||
|     end; | ||||
|   finally | ||||
|     TIdStack.DecUsage; | ||||
|   end; | ||||
| 
 | ||||
|   edtPort.Items.BeginUpdate; | ||||
|   try | ||||
|     edtPort.Items.Add(PortDescription(0)); | ||||
|     for i := 0 to IdPorts.Count - 1 do begin | ||||
|       edtPort.Items.Add( | ||||
|         PortDescription( | ||||
|           {$IFDEF HAS_GENERICS_TList} | ||||
|           IdPorts[i] | ||||
|           {$ELSE} | ||||
|           PtrInt(IdPorts[i]) | ||||
|           {$ENDIF} | ||||
|         ) | ||||
|       ); | ||||
|     end; | ||||
|   finally | ||||
|     edtPort.Items.EndUpdate; | ||||
|   end; | ||||
| 
 | ||||
|   AutoScroll := False; | ||||
|   Caption := RSBindingFormCaption; | ||||
|   {$IFDEF WIDGET_VCL} | ||||
|   Scaled := False; | ||||
|   {$ENDIF} | ||||
|   Font.Color := clBtnText; | ||||
|   Font.Height := -11; | ||||
|   Font.Name := 'MS Sans Serif';    {Do not Localize} | ||||
|   Font.Style := []; | ||||
|   Position := poScreenCenter; | ||||
|   PixelsPerInch := 96; | ||||
|   FInUpdateRoutine := False; | ||||
|   UpdateEditControls; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdDsnPropEdBindingVCL.Destroy; | ||||
| begin | ||||
|   FreeAndNil(FIPv4Addresses); | ||||
|   FreeAndNil(FIPv6Addresses); | ||||
|   FreeAndNil(FHandles); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| function TIdDsnPropEdBindingVCL.PortDescription(const PortNumber: integer): string; | ||||
| var | ||||
|   LList: TStringList; | ||||
| begin | ||||
|   if PortNumber = 0 then begin | ||||
|     Result := IndyFormat('%d: %s', [PortNumber, RSBindingAny]); | ||||
|   end else begin | ||||
|     Result := '';    {Do not Localize} | ||||
|     LList := TStringList.Create; | ||||
|     try | ||||
|       GBSDStack.AddServByPortToList(PortNumber, LList); | ||||
|       if LList.Count > 0 then begin | ||||
|         Result := Format('%d: %s', [PortNumber, LList.CommaText]);    {Do not Localize} | ||||
|       end; | ||||
|     finally | ||||
|       LList.Free; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.SetHandles(const Value: TIdSocketHandles); | ||||
| begin | ||||
|   FHandles.Assign(Value); | ||||
|   UpdateBindingList; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.btnBindingsNewExecute(Sender: TObject); | ||||
| begin | ||||
|   FCurrentHandle := FHandles.Add; | ||||
|   FCurrentHandle.IP := IPv4Wildcard; | ||||
|   FCurrentHandle.Port := FDefaultPort; | ||||
|   UpdateBindingList; | ||||
|   edtIPAddress.Items.Assign(FIPv4Addresses); | ||||
|   UpdateEditControls; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.UpdateEditControls; | ||||
| var | ||||
|   i : Integer; | ||||
| begin | ||||
|   if Assigned(FCurrentHandle) then | ||||
|   begin | ||||
|     i := IndexOfNo(FCurrentHandle.Port,edtPort.Items); | ||||
|     if i = -1 then begin | ||||
|       edtPort.Text := IntToStr(FCurrentHandle.Port); | ||||
|     end else begin | ||||
|       edtPort.ItemIndex := i; | ||||
|     end; | ||||
| 
 | ||||
|     case FCurrentHandle.IPVersion of | ||||
|       Id_IPv4 : | ||||
|       begin | ||||
|         rdoBindingType.ItemIndex := 0; | ||||
|         edtIPAddress.Items.Assign(FIPv4Addresses); | ||||
|       end; | ||||
|       Id_IPv6 : | ||||
|       begin | ||||
|         rdoBindingType.ItemIndex := 1; | ||||
|         edtIPAddress.Items.Assign(FIPv6Addresses); | ||||
|       end; | ||||
|     end; | ||||
|     if edtIPAddress.Style = csDropDown then begin | ||||
|       edtIPAddress.Text := FCurrentHandle.IP; | ||||
|     end else begin | ||||
|       edtIPAddress.ItemIndex := edtIPAddress.Items.IndexOf(FCurrentHandle.IP); | ||||
|     end; | ||||
|   end | ||||
|   else | ||||
|   begin | ||||
|     edtIPAddress.Text := ''; | ||||
|     //in LCL, the line below caused an index out of range error. | ||||
|     {$IFDEF WIDGET_VCL} | ||||
|     edtPort.ItemIndex := -1; //-2; | ||||
|     {$ENDIF} | ||||
|     edtPort.Text := ''; | ||||
|   end; | ||||
| 
 | ||||
|   lblIPAddress.Enabled := Assigned(FCurrentHandle); | ||||
|   edtIPAddress.Enabled := Assigned(FCurrentHandle); | ||||
|   lblPort.Enabled := Assigned(FCurrentHandle); | ||||
|   edtPort.Enabled := Assigned(FCurrentHandle); | ||||
|   rdoBindingType.Enabled := Assigned(FCurrentHandle); | ||||
|   {$IFDEF WIDGET_KYLIX} | ||||
|   //WOrkaround for CLX quirk that might be Kylix 1 | ||||
|   for i := 0 to rdoBindingType.ControlCount -1 do begin | ||||
|     rdoBindingType.Controls[i].Enabled := Assigned(FCurrentHandle); | ||||
|   end; | ||||
|   {$ENDIF} | ||||
|   {$IFDEF WIDGET_VCL_LIKE} | ||||
|   //The Win32 VCL does not change the control background to a greyed look | ||||
|   //when controls are disabled.  This quirk is not present in CLX. | ||||
|   if Assigned(FCurrentHandle) then | ||||
|   begin | ||||
|     edtIPAddress.Color := clWindow; | ||||
|     edtPort.Color := clWindow; | ||||
|   end else | ||||
|   begin | ||||
|     edtIPAddress.Color := clBtnFace; | ||||
|     edtPort.Color := clBtnFace; | ||||
|   end; | ||||
|   {$ENDIF} | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.btnBindingsDeleteExecute(Sender: TObject); | ||||
| var | ||||
|   LSH : TIdSocketHandle; | ||||
| begin | ||||
|   if lbBindings.ItemIndex >= 0 then | ||||
|   begin | ||||
|     // Delete is not available in D4's collection classes | ||||
|     // This should work just as well. | ||||
|     LSH := Handles[lbBindings.ItemIndex]; | ||||
|     FreeAndNil(LSH); | ||||
|     FCurrentHandle := nil; | ||||
|     UpdateBindingList; | ||||
|   end; | ||||
|   lbBindingsClick(nil); | ||||
|   UpdateEditControls; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.btnBindingsDeleteUpdate(Sender: TObject); | ||||
| begin | ||||
|   btnBindingsDelete.Enabled := lbBindings.ItemIndex >= 0; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.SetIPv4Addresses(const Value: TStrings); | ||||
| begin | ||||
|   if Assigned(Value) then begin | ||||
|     FIPv4Addresses.Assign(Value); | ||||
|   end; | ||||
|   // Ensure that these two are always present | ||||
|   if FIPv4Addresses.IndexOf(IPv6Loopback) = -1 then begin | ||||
|     FIPv4Addresses.Insert(0, IPv4Loopback); | ||||
|   end; | ||||
|   if FIPv4Addresses.IndexOf(IPv4Wildcard) = -1 then begin | ||||
|     FIPv4Addresses.Insert(0, IPv4Wildcard); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.SetIPv6Addresses(const Value: TStrings); | ||||
| begin | ||||
|   if Assigned(Value) then begin | ||||
|     FIPv6Addresses.Assign(Value); | ||||
|   end; | ||||
|   // Ensure that these two are always present | ||||
|   if FIPv6Addresses.IndexOf(IPv6Loopback) = -1 then begin | ||||
|     FIPv6Addresses.Insert(0, IPv6Loopback); | ||||
|   end; | ||||
|   if FIPv6Addresses.IndexOf(IPv6Wildcard1) = -1 then begin | ||||
|     FIPv6Addresses.Insert(0, IPv6Wildcard1); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.edtPortKeyPress(Sender: TObject; var Key: Char); | ||||
| begin | ||||
|   // RLebeau 1/7/09: using Char() for #128-#255 because in D2009, the compiler | ||||
|   // may change characters >= #128 from their Ansi codepage value to their true | ||||
|   // Unicode codepoint value, depending on the codepage used for the source code. | ||||
|   // For instance, #128 may become #$20AC... | ||||
| 
 | ||||
|   if (Key > Chr(31)) and (Key < Chr(128)) then begin | ||||
|     if not IsNumeric(Key) then begin | ||||
|       Key := #0; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.edtIPAddressChange(Sender: TObject); | ||||
| begin | ||||
|   FCurrentHandle.IP := edtIPAddress.Text; | ||||
|   UpdateBindingList; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.edtPortChange(Sender: TObject); | ||||
| begin | ||||
|   if Assigned(FCurrentHandle) then begin | ||||
|     FCurrentHandle.Port := IndyStrToInt(NumericOnly(edtPort.Text), 0); | ||||
|   end; | ||||
|   UpdateBindingList; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.rdoBindingTypeClick(Sender: TObject); | ||||
| begin | ||||
|   case rdoBindingType.ItemIndex of | ||||
|     0 : | ||||
|     begin | ||||
|       if FCurrentHandle.IPVersion <> Id_IPv4 then | ||||
|       begin | ||||
|         FCurrentHandle.IPVersion := Id_IPv4; | ||||
|         edtIPAddress.Items.Assign(FIPv4Addresses); | ||||
|         FCurrentHandle.IP := IPv4Wildcard; | ||||
|       end; | ||||
|     end; | ||||
|     1 : | ||||
|     begin | ||||
|       if FCurrentHandle.IPVersion <> Id_IPv6 then | ||||
|       begin | ||||
|         FCurrentHandle.IPVersion := Id_IPv6; | ||||
|         edtIPAddress.Items.Assign(FIPv6Addresses); | ||||
|         FCurrentHandle.IP := IPv6Wildcard1; | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
|   UpdateEditControls; | ||||
|   UpdateBindingList; | ||||
| end; | ||||
| 
 | ||||
| function TIdDsnPropEdBindingVCL.GetList: string; | ||||
| begin | ||||
|   Result := GetListValues(Handles); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.lbBindingsClick(Sender: TObject); | ||||
| begin | ||||
|   if lbBindings.ItemIndex >= 0 then begin | ||||
|     FCurrentHandle := FHandles[lbBindings.ItemIndex]; | ||||
|   end else begin | ||||
|     FCurrentHandle := nil; | ||||
|   end; | ||||
|   UpdateEditControls; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.SetList(const AList: string); | ||||
| begin | ||||
|   FCurrentHandle := nil; | ||||
|   FillHandleList(AList, Handles); | ||||
|   UpdateBindingList; | ||||
|   UpdateEditControls; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdDsnPropEdBindingVCL.UpdateBindingList; | ||||
| var | ||||
|   i: integer; | ||||
|   selected: integer; | ||||
|   s: string; | ||||
| begin | ||||
| //in Lazarus, for some odd reason, if you have more than one binding, | ||||
| //the routine is called while the items are updated | ||||
|   if FInUpdateRoutine then begin | ||||
|     Exit; | ||||
|   end; | ||||
|   FInUpdateRoutine := True; | ||||
|   try | ||||
|     selected := lbBindings.ItemIndex; | ||||
|     lbBindings.Items.BeginUpdate; | ||||
|     try | ||||
|       if lbBindings.Items.Count = FHandles.Count then begin | ||||
|         for i := 0 to FHandles.Count - 1 do begin | ||||
|           s := GetDisplayString(FHandles[i]); | ||||
|           if s <> lbBindings.Items[i] then begin | ||||
|             lbBindings.Items[i] := s; | ||||
|           end; | ||||
|         end; | ||||
|       end else begin | ||||
|         lbBindings.Items.Clear; | ||||
|         for i := 0 to FHandles.Count-1 do begin | ||||
|           lbBindings.Items.Add(GetDisplayString(FHandles[i])); | ||||
|         end; | ||||
|       end; | ||||
|     finally | ||||
|       lbBindings.Items.EndUpdate; | ||||
|       if Assigned(FCurrentHandle) then begin | ||||
|         lbBindings.ItemIndex := FCurrentHandle.Index; | ||||
|       end else begin | ||||
|         lbBindings.ItemIndex := IndyMin(selected, lbBindings.Items.Count-1); | ||||
|       end; | ||||
|     end; | ||||
|   finally | ||||
|     FInUpdateRoutine := False; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdDsnPropEdBindingVCL.Execute: Boolean; | ||||
| begin | ||||
|   Result := ShowModal = mrOk; | ||||
| end; | ||||
| 
 | ||||
| constructor TIdDsnPropEdBindingVCL.Create; | ||||
| begin | ||||
|   Create(nil); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										191
									
								
								indy/Core/IdExceptionCore.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,191 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.3    09/06/2004 09:52:34  CCostelloe | ||||
|   Kylix 3 patch | ||||
| 
 | ||||
|   Rev 1.2    6/4/2004 5:12:56 PM  SGrobety | ||||
|   added EIdMaxCaptureLineExceeded | ||||
| 
 | ||||
|   Rev 1.1    2/10/2004 7:41:50 PM  JPMugaas | ||||
|   I had to move EWrapperException down to the system package because | ||||
|   IdStackDotNET was using it and that would drage IdExceptionCore into the | ||||
|   package.  Borland changed some behavior so the warning is now an error. | ||||
| 
 | ||||
|   Rev 1.0    2004.02.03 4:19:48 PM  czhower | ||||
|   Rename | ||||
| 
 | ||||
|   Rev 1.15    11/4/2003 10:26:58 PM  DSiders | ||||
|   Added exceptions moved from IdIOHandler.pas and IdTCPConnection.pas. | ||||
| 
 | ||||
|   Rev 1.14    2003.10.16 11:24:00 AM  czhower | ||||
|   Added IfAssigned | ||||
| 
 | ||||
|   Rev 1.13    2003.10.11 5:47:58 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.12    10/3/2003 11:38:36 PM  GGrieve | ||||
|   Add EIdWrapperException | ||||
| 
 | ||||
|   Rev 1.11    9/29/2003 02:56:28 PM  JPMugaas | ||||
|   Added comment about why IdException.Create is virtual. | ||||
| 
 | ||||
|   Rev 1.10    9/24/2003 11:42:50 PM  JPMugaas | ||||
|   Minor changes to help compile under NET | ||||
| 
 | ||||
|   Rev 1.9    2003.09.19 10:10:02 PM  czhower | ||||
|   IfTrue, IfFalse | ||||
| 
 | ||||
|   Rev 1.8    2003.09.19 11:54:28 AM  czhower | ||||
|   -Completed more features necessary for servers | ||||
|   -Fixed some bugs | ||||
| 
 | ||||
|   Rev 1.7    2003.07.17 4:57:04 PM  czhower | ||||
|   Added new exception type so it can be added to debugger list of ignored | ||||
|   exceptions. | ||||
| 
 | ||||
|   Rev 1.6    7/1/2003 8:33:02 PM  BGooijen | ||||
|   Added EIdFibersNotSupported | ||||
| 
 | ||||
|   Rev 1.5    2003.06.05 10:08:50 AM  czhower | ||||
|   Extended reply mechanisms to the exception handling. Only base and RFC | ||||
|   completed, handing off to J Peter. | ||||
| 
 | ||||
|   Rev 1.4    5/14/2003 2:59:58 PM  BGooijen | ||||
|   Added exception for transparant proxy | ||||
| 
 | ||||
|   Rev 1.3    2003.04.14 10:54:06 AM  czhower | ||||
|   Fiber specific exceptions | ||||
| 
 | ||||
|   Rev 1.2    4/2/2003 7:18:38 PM  BGooijen | ||||
|   Added EIdHttpProxyError | ||||
| 
 | ||||
|   Rev 1.1    1/17/2003 05:06:46 PM  JPMugaas | ||||
|   Exceptions for scheduler string. | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:44:10 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdExceptionCore; | ||||
| 
 | ||||
| interface | ||||
| {$I IdCompilerDefines.inc} | ||||
| //needed to put FCP into Delphi mode | ||||
| uses | ||||
|   IdException, IdStack; | ||||
| 
 | ||||
| type | ||||
|   // IdFiber Exceptions | ||||
|   EIdFiber = class(EIdException); | ||||
|   EIdFiberFinished = class(EIdFiber); | ||||
|   EIdFibersNotSupported = class(EIdFiber); | ||||
| 
 | ||||
|   EIdAlreadyConnected = class(EIdException); | ||||
| 
 | ||||
|   // EIdClosedSocket is raised if .Disconnect has been called and an operation is attempted | ||||
|   // or Connect has not been called | ||||
|   EIdClosedSocket = class(EIdException); | ||||
|   EIdResponseError = class(EIdException); | ||||
|   EIdReadTimeout = class(EIdException); | ||||
|   EIdAcceptTimeout = class(EIdException); | ||||
|   EIdReadLnMaxLineLengthExceeded = class(EIdException); | ||||
|   EIdReadLnWaitMaxAttemptsExceeded = class(EIdException); | ||||
| 
 | ||||
|   // TIdTCPConnection exceptions | ||||
|   EIdPortRequired = class(EIdException); | ||||
|   EIdHostRequired = class(EIdException); | ||||
|   EIdTCPConnectionError = class(EIdException); | ||||
|   EIdObjectTypeNotSupported = class(EIdTCPConnectionError); | ||||
|   EIdInterceptPropIsNil = class(EIdTCPConnectionError); | ||||
|   EIdInterceptPropInvalid = class(EIdTCPConnectionError); | ||||
|   EIdIOHandlerPropInvalid = class(EIdTCPConnectionError); | ||||
|   EIdNoDataToRead = class(EIdTCPConnectionError); | ||||
|   EIdFileNotFound = class(EIdTCPConnectionError); | ||||
| 
 | ||||
|   EIdNotConnected = class(EIdException); | ||||
| 
 | ||||
|   EInvalidSyslogMessage = class(EIdException); | ||||
|   EIdSSLProtocolReplyError = class(EIdException); | ||||
|   EIdConnectTimeout = class(EIdException); | ||||
|   EIdConnectException = class(EIdException); | ||||
| 
 | ||||
|   EIdTransparentProxyCantBind = class(EIdException); | ||||
| 
 | ||||
|   EIdHttpProxyError = class(EIdException); | ||||
| 
 | ||||
|   EIdSocksError = class(EIdException); | ||||
|   EIdSocksRequestFailed = class(EIdSocksError); | ||||
|   EIdSocksRequestServerFailed = class(EIdSocksError); | ||||
|   EIdSocksRequestIdentFailed = class(EIdSocksError); | ||||
|   EIdSocksUnknownError = class(EIdSocksError); | ||||
|   EIdSocksServerRespondError = class(EIdSocksError); | ||||
|   EIdSocksAuthMethodError = class(EIdSocksError); | ||||
|   EIdSocksAuthError = class(EIdSocksError); | ||||
|   EIdSocksServerGeneralError = class(EIdSocksError); | ||||
|   EIdSocksServerPermissionError = class (EIdSocksError); | ||||
|   EIdSocksServerNetUnreachableError = class (EIdSocksError); | ||||
|   EIdSocksServerHostUnreachableError = class (EIdSocksError); | ||||
|   EIdSocksServerConnectionRefusedError = class (EIdSocksError); | ||||
|   EIdSocksServerTTLExpiredError = class (EIdSocksError); | ||||
|   EIdSocksServerCommandError = class (EIdSocksError); | ||||
|   EIdSocksServerAddressError = class (EIdSocksError); | ||||
| 
 | ||||
|   //IdIMAP4 Exception | ||||
|   EIdConnectionStateError = class(EIdException); | ||||
| 
 | ||||
|   // THE EDnsResolverError is used so the resolver can repond to only resolver execeptions. | ||||
|   EIdDnsResolverError = Class(EIdException); | ||||
| 
 | ||||
|   {Socket exceptions} | ||||
|   EIdInvalidSocket = class(EIdException); | ||||
| 
 | ||||
|   EIdThreadMgrError = class(EIdException); | ||||
|   EIdThreadClassNotSpecified = class(EIdThreadMgrError); | ||||
| 
 | ||||
|   {TIdTrivial FTP Exception } | ||||
|   EIdTFTPException               = class(EIdException); | ||||
|   EIdTFTPFileNotFound            = class(EIdTFTPException); | ||||
|   EIdTFTPAccessViolation         = class(EIdTFTPException); | ||||
|   EIdTFTPAllocationExceeded      = class(EIdTFTPException); | ||||
|   EIdTFTPIllegalOperation        = class(EIdTFTPException); | ||||
|   EIdTFTPUnknownTransferID       = class(EIdTFTPException); | ||||
|   EIdTFTPFileAlreadyExists       = class(EIdTFTPException); | ||||
|   EIdTFTPNoSuchUser              = class(EIdTFTPException); | ||||
|   EIdTFTPOptionNegotiationFailed = class(EIdTFTPException);  // RFC 1782 | ||||
| 
 | ||||
|   {Icmp exceptions} | ||||
|   EIdIcmpException = class(EIdException); | ||||
| 
 | ||||
|   EIdSetSizeExceeded = class(EIdException); | ||||
| 
 | ||||
|   {IdMessage and things use this} | ||||
|   EIdMessageException = class(EIdException); | ||||
| 
 | ||||
|   //scheduler exception | ||||
|   EIdSchedulerException = class(EIdException); | ||||
|   EIdSchedulerMaxThreadsExceeded = class(EIdSchedulerException); | ||||
| 
 | ||||
|   { IdIOHandler } | ||||
|   EIdMaxCaptureLineExceeded = class(EIdException); // S.G. 6/4/2004: triggered when a capture command exceeds the maximum number of line allowed | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										48
									
								
								indy/Core/IdGlobalCore.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,48 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.2    8/16/2004 1:08:46 PM  JPMugaas | ||||
|   Failed to compile in some IDE's. | ||||
| 
 | ||||
|   Rev 1.1    2004.08.13 21:46:20  czhower | ||||
|   Fix for .NET | ||||
| 
 | ||||
|   Rev 1.0    2004.08.13 10:54:58  czhower | ||||
|   Initial checkin | ||||
| } | ||||
| 
 | ||||
| unit IdGlobalCore; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdGlobal; | ||||
| 
 | ||||
| const | ||||
|   {$IFDEF UNIX} | ||||
|   tpListener = tpNormal; | ||||
|   {$ELSE} | ||||
|   tpListener = tpHighest; | ||||
|   {$ENDIF} | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										2695
									
								
								indy/Core/IdIOHandler.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										575
									
								
								indy/Core/IdIOHandlerSocket.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,575 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.38    11/10/2004 8:25:54 AM  JPMugaas | ||||
|   Fix for AV caused by short-circut boolean evaluation. | ||||
| 
 | ||||
|   Rev 1.37    27.08.2004 21:58:20  Andreas Hausladen | ||||
|   Speed optimization ("const" for string parameters) | ||||
| 
 | ||||
|   Rev 1.36    8/2/04 5:44:40 PM  RLebeau | ||||
|   Moved ConnectTimeout over from TIdIOHandlerStack | ||||
| 
 | ||||
|   Rev 1.35    7/21/2004 12:22:32 PM  BGooijen | ||||
|   Fix to .connected | ||||
| 
 | ||||
|   Rev 1.34    6/30/2004 12:31:34 PM  BGooijen | ||||
|   Added OnSocketAllocated | ||||
| 
 | ||||
|   Rev 1.33    4/24/04 12:52:52 PM  RLebeau | ||||
|   Added setter method to UseNagle property | ||||
| 
 | ||||
|   Rev 1.32    2004.04.18 12:52:02 AM  czhower | ||||
|   Big bug fix with server disconnect and several other bug fixed that I found | ||||
|   along the way. | ||||
| 
 | ||||
|   Rev 1.31    2004.02.03 4:16:46 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.30    2/2/2004 11:46:46 AM  BGooijen | ||||
|   Dotnet and TransparentProxy | ||||
| 
 | ||||
|   Rev 1.29    2/1/2004 9:44:00 PM  JPMugaas | ||||
|   Start on reenabling Transparant proxy. | ||||
| 
 | ||||
|   Rev 1.28    2004.01.20 10:03:28 PM  czhower | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.27    1/2/2004 12:02:16 AM  BGooijen | ||||
|   added OnBeforeBind/OnAfterBind | ||||
| 
 | ||||
|   Rev 1.26    12/31/2003 9:51:56 PM  BGooijen | ||||
|   Added IPv6 support | ||||
| 
 | ||||
|   Rev 1.25    11/4/2003 10:37:40 PM  BGooijen | ||||
|   JP's patch to fix the bound port | ||||
| 
 | ||||
|   Rev 1.24    10/19/2003 5:21:26 PM  BGooijen | ||||
|   SetSocketOption | ||||
| 
 | ||||
|   Rev 1.23    10/18/2003 1:44:06 PM  BGooijen | ||||
|   Added include | ||||
| 
 | ||||
|   Rev 1.22    2003.10.14 1:26:54 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.21    10/9/2003 8:09:06 PM  SPerry | ||||
|   bug fixes | ||||
| 
 | ||||
|   Rev 1.20    8/10/2003 2:05:50 PM  SGrobety | ||||
|   Dotnet | ||||
| 
 | ||||
|   Rev 1.19    2003.10.07 10:18:26 PM  czhower | ||||
|   Uncommneted todo code that is now non dotnet. | ||||
| 
 | ||||
|   Rev 1.18    2003.10.02 8:23:42 PM  czhower | ||||
|   DotNet Excludes | ||||
| 
 | ||||
|   Rev 1.17    2003.10.01 9:11:18 PM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.16    2003.10.01 5:05:12 PM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.15    2003.10.01 2:46:38 PM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.14    2003.10.01 11:16:32 AM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.13    2003.09.30 1:22:58 PM  czhower | ||||
|   Stack split for DotNet | ||||
| 
 | ||||
|   Rev 1.12    7/4/2003 08:26:44 AM  JPMugaas | ||||
|   Optimizations. | ||||
| 
 | ||||
|   Rev 1.11    7/1/2003 03:39:44 PM  JPMugaas | ||||
|   Started numeric IP function API calls for more efficiency. | ||||
| 
 | ||||
|   Rev 1.10    2003.06.30 5:41:56 PM  czhower | ||||
|   -Fixed AV that occurred sometimes when sockets were closed with chains | ||||
|   -Consolidated code that was marked by a todo for merging as it no longer | ||||
|   needed to be separate | ||||
|   -Removed some older code that was no longer necessary | ||||
| 
 | ||||
|   Passes bubble tests. | ||||
| 
 | ||||
|   Rev 1.9    6/3/2003 11:45:58 PM  BGooijen | ||||
|   Added .Connected | ||||
| 
 | ||||
|   Rev 1.8    2003.04.22 7:45:34 PM  czhower | ||||
| 
 | ||||
|   Rev 1.7    4/2/2003 3:24:56 PM  BGooijen | ||||
|   Moved transparantproxy from ..stack to ..socket | ||||
| 
 | ||||
|   Rev 1.6    2/28/2003 9:51:56 PM  BGooijen | ||||
|   removed the field: FReadTimeout: Integer, it hided the one in TIdIOHandler | ||||
| 
 | ||||
|   Rev 1.5    2/26/2003 1:15:38 PM  BGooijen | ||||
|   FBinding is now freed in IdIOHandlerSocket, instead of in IdIOHandlerStack | ||||
| 
 | ||||
|   Rev 1.4    2003.02.25 1:36:08 AM  czhower | ||||
| 
 | ||||
|   Rev 1.3    2002.12.07 12:26:26 AM  czhower | ||||
| 
 | ||||
|   Rev 1.2    12-6-2002 20:09:14  BGooijen | ||||
|   Changed SetDestination to search for the last ':', instead of the first | ||||
| 
 | ||||
|   Rev 1.1    12-6-2002 18:54:14  BGooijen | ||||
|   Added IPv6-support | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:45:08 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdIOHandlerSocket; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdCustomTransparentProxy, | ||||
|   IdBaseComponent, | ||||
|   IdGlobal, | ||||
|   IdIOHandler, | ||||
|   IdSocketHandle; | ||||
| 
 | ||||
| const | ||||
|   IdDefTimeout = 0; | ||||
|   IdBoundPortDefault = 0; | ||||
| 
 | ||||
| type | ||||
|   { | ||||
|   TIdIOHandlerSocket is the base class for socket IOHandlers that implement a | ||||
|   binding. | ||||
| 
 | ||||
|   Descendants | ||||
|     -TIdIOHandlerStack | ||||
|     -TIdIOHandlerChain | ||||
|   } | ||||
|   TIdIOHandlerSocket = class(TIdIOHandler) | ||||
|   protected | ||||
|     FBinding: TIdSocketHandle; | ||||
|     FBoundIP: string; | ||||
|     FBoundPort: TIdPort; | ||||
|     FBoundPortMax: TIdPort; | ||||
|     FBoundPortMin: TIdPort; | ||||
|     FDefaultPort: TIdPort; | ||||
|     FOnBeforeBind: TNotifyEvent; | ||||
|     FOnAfterBind: TNotifyEvent; | ||||
|     FOnSocketAllocated: TNotifyEvent; | ||||
|     {$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FTransparentProxy: TIdCustomTransparentProxy; | ||||
|     FImplicitTransparentProxy: Boolean; | ||||
|     FUseNagle: Boolean; | ||||
|     FReuseSocket: TIdReuseSocket; | ||||
|     FIPVersion: TIdIPVersion; | ||||
|     // | ||||
|     procedure ConnectClient; virtual; | ||||
|     procedure DoBeforeBind; virtual; | ||||
|     procedure DoAfterBind; virtual; | ||||
|     procedure DoSocketAllocated; virtual; | ||||
|     procedure InitComponent; override; | ||||
|     procedure Notification(AComponent: TComponent; Operation: TOperation); override; | ||||
|     function GetDestination: string; override; | ||||
|     procedure SetDestination(const AValue: string); override; | ||||
|     function GetReuseSocket: TIdReuseSocket; | ||||
|     procedure SetReuseSocket(AValue: TIdReuseSocket); | ||||
|     function GetTransparentProxy: TIdCustomTransparentProxy; virtual; | ||||
|     procedure SetTransparentProxy(AProxy: TIdCustomTransparentProxy); virtual; | ||||
|     function GetUseNagle: Boolean; | ||||
|     procedure SetUseNagle(AValue: Boolean); | ||||
|     // | ||||
|     function SourceIsAvailable: Boolean; override; | ||||
|     function CheckForError(ALastResult: Integer): Integer; override; | ||||
|     procedure RaiseError(AError: Integer); override; | ||||
|   public | ||||
|     procedure AfterAccept; override; | ||||
|     destructor Destroy; override; | ||||
|     function BindingAllocated: Boolean; | ||||
|     procedure Close; override; | ||||
|     function Connected: Boolean; override; | ||||
|     procedure Open; override; | ||||
|     function WriteFile(const AFile: String; AEnableTransferFile: Boolean = False): Int64; override; | ||||
|     // | ||||
|     property Binding: TIdSocketHandle read FBinding; | ||||
|     property BoundPortMax: TIdPort read FBoundPortMax write FBoundPortMax; | ||||
|     property BoundPortMin: TIdPort read FBoundPortMin write FBoundPortMin; | ||||
|     // events | ||||
|     property OnBeforeBind: TNotifyEvent read FOnBeforeBind write FOnBeforeBind; | ||||
|     property OnAfterBind: TNotifyEvent read FOnAfterBind write FOnAfterBind; | ||||
|     property OnSocketAllocated: TNotifyEvent read FOnSocketAllocated write FOnSocketAllocated; | ||||
|   published | ||||
|     property BoundIP: string read FBoundIP write FBoundIP; | ||||
|     property BoundPort: TIdPort read FBoundPort write FBoundPort default IdBoundPortDefault; | ||||
|     property DefaultPort: TIdPort read FDefaultPort write FDefaultPort; | ||||
|     property IPVersion: TIdIPVersion read FIPVersion write FIPVersion default ID_DEFAULT_IP_VERSION; | ||||
|     property ReuseSocket: TIdReuseSocket read GetReuseSocket write SetReuseSocket default rsOSDependent; | ||||
|     property TransparentProxy: TIdCustomTransparentProxy read GetTransparentProxy write SetTransparentProxy; | ||||
|     property UseNagle: boolean read GetUseNagle write SetUseNagle default True; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   //facilitate inlining only. | ||||
|   {$IFDEF DOTNET} | ||||
|     {$IFDEF USE_INLINE} | ||||
|   System.IO, | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   {$IFDEF WIN32_OR_WIN64 } | ||||
|   Windows, | ||||
|   {$ENDIF} | ||||
|   SysUtils, | ||||
|   IdStack, | ||||
|   IdStackConsts, | ||||
|   IdSocks; | ||||
| 
 | ||||
| { TIdIOHandlerSocket } | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.AfterAccept; | ||||
| begin | ||||
|   inherited AfterAccept; | ||||
|   FIPVersion := FBinding.IPVersion; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.Close; | ||||
| begin | ||||
|   if FBinding <> nil then begin | ||||
|     FBinding.CloseSocket; | ||||
|   end; | ||||
|   inherited Close; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.ConnectClient; | ||||
| var | ||||
|   LBinding: TIdSocketHandle; | ||||
| begin | ||||
|   LBinding := Binding; | ||||
|   DoBeforeBind; | ||||
|   // Allocate the socket | ||||
|   LBinding.IPVersion := FIPVersion; | ||||
|   LBinding.AllocateSocket; | ||||
|   DoSocketAllocated; | ||||
|   // Bind the socket | ||||
|   if BoundIP <> '' then begin | ||||
|     LBinding.IP := BoundIP; | ||||
|   end; | ||||
|   LBinding.Port := BoundPort; | ||||
|   LBinding.ClientPortMin := BoundPortMin; | ||||
|   LBinding.ClientPortMax := BoundPortMax; | ||||
|   LBinding.ReuseSocket := FReuseSocket; | ||||
| 
 | ||||
|   // RLebeau 11/15/2014: Using the socket bind() function in a Mac OSX sandbox | ||||
|   // causes the Apple store to reject an app with the following error if it | ||||
|   // uses Indy client(s) and no Indy server(s): | ||||
|   // | ||||
|   // "This app uses one or more entitlements which do not have matching | ||||
|   // functionality within the app. Apps should have only the minimum set of | ||||
|   // entitlements necessary for the app to function properly. Please remove | ||||
|   // all entitlements that are not needed by your app and submit an updated | ||||
|   // binary for review, including the following: | ||||
|   // | ||||
|   // com.apple.security.network.server" | ||||
|   // | ||||
|   // Ideally, TIdSocketHandle.Bind() should not call TryBind() if the IP is | ||||
|   // blank and the Port, ClientPortMin, and ClientPortMax are all 0.  However, | ||||
|   // TIdSocketHandle.Bind() is used for both clients and servers, and sometimes | ||||
|   // a server needs to bind to port 0 to get a random ephemeral port, which it | ||||
|   // can then report to clients.  So lets do the check here instead, as this | ||||
|   // method is only used for clients... | ||||
| 
 | ||||
|   {$IFDEF DARWIN} | ||||
|   // TODO: remove the DARWIN check and just skip the Bind() on all platforms? | ||||
|   if (LBinding.IP <> '') or (LBinding.Port <> 0) or | ||||
|      ((LBinding.ClientPortMin <> 0) and (LBinding.ClientPortMax <> 0)) then | ||||
|   begin | ||||
|     LBinding.Bind; | ||||
|   end; | ||||
|   {$ELSE} | ||||
|   LBinding.Bind; | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   // Turn off Nagle if specified | ||||
|   LBinding.UseNagle := FUseNagle; | ||||
|   DoAfterBind; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerSocket.Connected: Boolean; | ||||
| begin | ||||
|   Result := (BindingAllocated and inherited Connected) or (not InputBufferIsEmpty); | ||||
| end; | ||||
| 
 | ||||
| destructor TIdIOHandlerSocket.Destroy; | ||||
| begin | ||||
|   SetTransparentProxy(nil); | ||||
|   FreeAndNil(FBinding); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.DoBeforeBind; | ||||
| begin | ||||
|   if Assigned(FOnBeforeBind) then begin | ||||
|     FOnBeforeBind(self); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.DoAfterBind; | ||||
| begin | ||||
|   if Assigned(FOnAfterBind) then begin | ||||
|     FOnAfterBind(self); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.DoSocketAllocated; | ||||
| begin | ||||
|   if Assigned(FOnSocketAllocated) then begin | ||||
|     FOnSocketAllocated(self); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerSocket.GetDestination: string; | ||||
| begin | ||||
|   Result := Host; | ||||
|   if (Port <> DefaultPort) and (Port > 0) then begin | ||||
|     Result := Host + ':' + IntToStr(Port); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.Open; | ||||
| begin | ||||
|   inherited Open; | ||||
| 
 | ||||
|   if not Assigned(FBinding) then begin | ||||
|     FBinding := TIdSocketHandle.Create(nil); | ||||
|   end else begin | ||||
|     FBinding.Reset(True); | ||||
|   end; | ||||
|   FBinding.ClientPortMin := BoundPortMin; | ||||
|   FBinding.ClientPortMax := BoundPortMax; | ||||
| 
 | ||||
|   //if the IOHandler is used to accept connections then port+host will be empty | ||||
|   if (Host <> '') and (Port > 0) then begin | ||||
|     ConnectClient; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.SetDestination(const AValue: string); | ||||
| var | ||||
|   LPortStart: integer; | ||||
| begin | ||||
|   // Bas Gooijen 06-Dec-2002: Changed to search the last ':', instead of the first: | ||||
|   LPortStart := LastDelimiter(':', AValue); | ||||
|   if LPortStart > 0 then begin | ||||
|     Host := Copy(AValue, 1, LPortStart-1); | ||||
|     Port := IndyStrToInt(Trim(Copy(AValue, LPortStart + 1, $FF)), DefaultPort); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerSocket.BindingAllocated: Boolean; | ||||
| begin | ||||
|   Result := FBinding <> nil; | ||||
|   if Result then begin | ||||
|     Result := FBinding.HandleAllocated; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerSocket.WriteFile(const AFile: String; | ||||
|   AEnableTransferFile: Boolean): Int64; | ||||
|   {$IFDEF WIN32_OR_WIN64} | ||||
| var | ||||
|   LOldErrorMode : Integer; | ||||
|   {$ENDIF} | ||||
| begin | ||||
|   Result := 0; | ||||
|   {$IFDEF WIN32_OR_WIN64} | ||||
|   LOldErrorMode := SetErrorMode(SEM_FAILCRITICALERRORS); | ||||
|   try | ||||
|   {$ENDIF} | ||||
|   if FileExists(AFile) then begin | ||||
|     if Assigned(GServeFileProc) and (not WriteBufferingActive) | ||||
|      {and (Intercept = nil)} and AEnableTransferFile | ||||
|      then begin | ||||
|       Result := GServeFileProc(Binding.Handle, AFile); | ||||
|       Exit; | ||||
|     end | ||||
|     else | ||||
|     begin | ||||
|       Result := inherited WriteFile(AFile, AEnableTransferFile); | ||||
|     end; | ||||
|   end; | ||||
|   {$IFDEF WIN32_OR_WIN64} | ||||
|   finally | ||||
|     SetErrorMode(LOldErrorMode) | ||||
|   end; | ||||
|   {$ENDIF} | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerSocket.GetReuseSocket: TIdReuseSocket; | ||||
| begin | ||||
|   if FBinding <> nil then begin | ||||
|     Result := FBinding.ReuseSocket; | ||||
|   end else begin | ||||
|     Result := FReuseSocket; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.SetReuseSocket(AValue: TIdReuseSocket); | ||||
| begin | ||||
|   FReuseSocket := AValue; | ||||
|   if FBinding <> nil then begin | ||||
|     FBinding.ReuseSocket := AValue; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.SetTransparentProxy(AProxy : TIdCustomTransparentProxy); | ||||
| var | ||||
|   LClass: TIdCustomTransparentProxyClass; | ||||
|   // under ARC, convert a weak reference to a strong reference before working with it | ||||
|   LTransparentProxy: TIdCustomTransparentProxy; | ||||
| begin | ||||
|   LTransparentProxy := FTransparentProxy; | ||||
| 
 | ||||
|   if LTransparentProxy <> AProxy then | ||||
|   begin | ||||
|     // All this is to preserve the compatibility with old version | ||||
|     // In the case when we have SocksInfo as object created in runtime without owner form it is treated as temporary object | ||||
|     // In the case when the ASocks points to an object with owner it is treated as component on form. | ||||
| 
 | ||||
|     // under ARC, all weak references to a freed object get nil'ed automatically | ||||
| 
 | ||||
|     if Assigned(AProxy) then begin | ||||
|       if not Assigned(AProxy.Owner) then begin | ||||
|         if Assigned(LTransparentProxy) and (not FImplicitTransparentProxy) then begin | ||||
|           FTransparentProxy := nil; | ||||
|           {$IFNDEF USE_OBJECT_ARC} | ||||
|           LTransparentProxy.RemoveFreeNotification(Self); | ||||
|           {$ENDIF} | ||||
|         end; | ||||
|         LClass := TIdCustomTransparentProxyClass(AProxy.ClassType); | ||||
|         if Assigned(LTransparentProxy) and (LTransparentProxy.ClassType <> LClass) then begin | ||||
|           FTransparentProxy := nil; | ||||
|           FImplicitTransparentProxy := False; | ||||
|           IdDisposeAndNil(LTransparentProxy); | ||||
|         end; | ||||
|         if not Assigned(LTransparentProxy) then begin | ||||
|           LTransparentProxy := LClass.Create(Self); | ||||
|           FTransparentProxy := LTransparentProxy; | ||||
|           FImplicitTransparentProxy := True; | ||||
|         end; | ||||
|         LTransparentProxy.Assign(AProxy); | ||||
|       end else begin | ||||
|         if Assigned(LTransparentProxy) then begin | ||||
|           if FImplicitTransparentProxy then begin | ||||
|             FTransparentProxy := nil; | ||||
|             FImplicitTransparentProxy := False; | ||||
|             IdDisposeAndNil(LTransparentProxy); | ||||
|           end else begin | ||||
|             {$IFNDEF USE_OBJECT_ARC} | ||||
|             LTransparentProxy.RemoveFreeNotification(Self); | ||||
|             {$ENDIF} | ||||
|           end; | ||||
|         end; | ||||
|         FTransparentProxy := AProxy; | ||||
|         {$IFNDEF USE_OBJECT_ARC} | ||||
|         AProxy.FreeNotification(Self); | ||||
|         {$ENDIF} | ||||
|       end; | ||||
|     end | ||||
|     else if Assigned(LTransparentProxy) then begin | ||||
|       if FImplicitTransparentProxy then begin | ||||
|         FTransparentProxy := nil; | ||||
|         FImplicitTransparentProxy := False; | ||||
|         IdDisposeAndNil(LTransparentProxy); | ||||
|       end else begin | ||||
|         FTransparentProxy := nil; | ||||
|         {$IFNDEF USE_OBJECT_ARC} | ||||
|         LTransparentProxy.RemoveFreeNotification(Self); | ||||
|         {$ENDIF} | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerSocket.GetTransparentProxy: TIdCustomTransparentProxy; | ||||
| var | ||||
|   // under ARC, convert a weak reference to a strong reference before working with it | ||||
|   LTransparentProxy: TIdCustomTransparentProxy; | ||||
| begin | ||||
|   LTransparentProxy := FTransparentProxy; | ||||
|   // Necessary at design time for Borland SOAP support | ||||
|   if LTransparentProxy = nil then begin | ||||
|     LTransparentProxy := TIdSocksInfo.Create(Self); //default | ||||
|     FTransparentProxy := LTransparentProxy; | ||||
|     FImplicitTransparentProxy := True; | ||||
|   end; | ||||
|   Result := LTransparentProxy; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerSocket.GetUseNagle: Boolean; | ||||
| begin | ||||
|   if FBinding <> nil then begin | ||||
|     Result := FBinding.UseNagle; | ||||
|   end else begin | ||||
|     Result := FUseNagle; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.SetUseNagle(AValue: Boolean); | ||||
| begin | ||||
|   FUseNagle := AValue; | ||||
|   if FBinding <> nil then begin | ||||
|     FBinding.UseNagle := AValue; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| // under ARC, all weak references to a freed object get nil'ed automatically | ||||
| // so this is mostly redundant | ||||
| procedure TIdIOHandlerSocket.Notification(AComponent: TComponent; Operation: TOperation); | ||||
| begin | ||||
|   if (Operation = opRemove) and (AComponent = FTransparentProxy) then begin | ||||
|     FTransparentProxy := nil; | ||||
|     FImplicitTransparentProxy := False; | ||||
|   end; | ||||
|   inherited Notification(AComponent, Operation); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FUseNagle := True; | ||||
|   FIPVersion := ID_DEFAULT_IP_VERSION; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerSocket.SourceIsAvailable: Boolean; | ||||
| begin | ||||
|   Result := BindingAllocated; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerSocket.CheckForError(ALastResult: Integer): Integer; | ||||
| begin | ||||
|   Result := GStack.CheckForSocketError(ALastResult, [Id_WSAESHUTDOWN, Id_WSAECONNABORTED, Id_WSAECONNRESET, Id_WSAETIMEDOUT]); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerSocket.RaiseError(AError: Integer); | ||||
| begin | ||||
|   GStack.RaiseSocketError(AError); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										442
									
								
								indy/Core/IdIOHandlerStack.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,442 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.53    3/10/05 3:23:16 PM  RLebeau | ||||
|   Updated WriteDirect() to access the Intercept property directly. | ||||
| 
 | ||||
|   Rev 1.52    11/12/2004 11:30:16 AM  JPMugaas | ||||
|   Expansions for IPv6. | ||||
| 
 | ||||
|   Rev 1.51    11/11/04 12:03:46 PM  RLebeau | ||||
|   Updated DoConnectTimeout() to recognize IdTimeoutDefault | ||||
| 
 | ||||
|   Rev 1.50    6/18/04 1:06:58 PM  RLebeau | ||||
|   Bug fix for ReadTimeout property | ||||
| 
 | ||||
|   Rev 1.49    5/4/2004 9:57:34 AM  JPMugaas | ||||
|   Removed some old uncommented code and reenabled some TransparentProxy code | ||||
|   since it compile in DotNET. | ||||
| 
 | ||||
|   Rev 1.48    2004.04.18 12:52:02 AM  czhower | ||||
|   Big bug fix with server disconnect and several other bug fixed that I found | ||||
|   along the way. | ||||
| 
 | ||||
|   Rev 1.47    2004.04.08 3:56:34 PM  czhower | ||||
|   Fixed bug with Intercept byte count. Also removed Bytes from Buffer. | ||||
| 
 | ||||
|   Rev 1.46    2004.03.12 8:01:00 PM  czhower | ||||
|   Exception update | ||||
| 
 | ||||
|   Rev 1.45    2004.03.07 11:48:42 AM  czhower | ||||
|   Flushbuffer fix + other minor ones found | ||||
| 
 | ||||
|   Rev 1.44    2004.03.01 5:12:32 PM  czhower | ||||
|   -Bug fix for shutdown of servers when connections still existed (AV) | ||||
|   -Implicit HELP support in CMDserver | ||||
|   -Several command handler bugs | ||||
|   -Additional command handler functionality. | ||||
| 
 | ||||
|   Rev 1.43    2/21/04 9:25:50 PM  RLebeau | ||||
|   Fix for BBG #66 | ||||
| 
 | ||||
|   Added FLastSocketError member to TIdConnectThread | ||||
| 
 | ||||
|   Rev 1.42    2004.02.03 4:16:48 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.41    12/31/2003 9:51:56 PM  BGooijen | ||||
|   Added IPv6 support | ||||
| 
 | ||||
|   Rev 1.40    2003.12.28 1:05:58 PM  czhower | ||||
|   .Net changes. | ||||
| 
 | ||||
|   Rev 1.39    11/21/2003 12:05:18 AM  BGooijen | ||||
|   Terminated isn't public in TThread any more, made it public here now | ||||
| 
 | ||||
|   Rev 1.38    10/28/2003 9:15:44 PM  BGooijen | ||||
|   .net | ||||
| 
 | ||||
|   Rev 1.37    10/18/2003 1:42:46 PM  BGooijen | ||||
|   Added include | ||||
| 
 | ||||
|   Rev 1.36    2003.10.14 1:26:56 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.35    2003.10.11 5:48:36 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.34    10/9/2003 8:09:10 PM  SPerry | ||||
|   bug fixes | ||||
| 
 | ||||
|   Rev 1.33    10/5/2003 11:02:36 PM  BGooijen | ||||
|   Write buffering | ||||
| 
 | ||||
|   Rev 1.32    05/10/2003 23:01:02  HHariri | ||||
|   Fix for connect problem when IP address specified as opposed to host | ||||
| 
 | ||||
|   Rev 1.31    2003.10.02 8:23:42 PM  czhower | ||||
|   DotNet Excludes | ||||
| 
 | ||||
|   Rev 1.30    2003.10.02 10:16:28 AM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.29    2003.10.01 9:11:18 PM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.28    2003.10.01 5:05:14 PM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.27    2003.10.01 2:46:38 PM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.26    2003.10.01 2:30:38 PM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.22    10/1/2003 12:14:14 AM  BGooijen | ||||
|   DotNet: removing CheckForSocketError | ||||
| 
 | ||||
|   Rev 1.21    2003.10.01 1:37:34 AM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.19    2003.09.30 1:22:58 PM  czhower | ||||
|   Stack split for DotNet | ||||
| 
 | ||||
|   Rev 1.18    2003.07.14 1:57:22 PM  czhower | ||||
|   -First set of IOCP fixes. | ||||
|   -Fixed a threadsafe problem with the stack class. | ||||
| 
 | ||||
|   Rev 1.17    2003.07.14 12:54:32 AM  czhower | ||||
|   Fixed graceful close detection if it occurs after connect. | ||||
| 
 | ||||
|   Rev 1.16    2003.07.10 4:34:58 PM  czhower | ||||
|   Fixed AV, added some new comments | ||||
| 
 | ||||
|   Rev 1.15    7/4/2003 08:26:46 AM  JPMugaas | ||||
|   Optimizations. | ||||
| 
 | ||||
|   Rev 1.14    7/1/2003 03:39:48 PM  JPMugaas | ||||
|   Started numeric IP function API calls for more efficiency. | ||||
| 
 | ||||
|     Rev 1.13    6/30/2003 10:25:18 AM  BGooijen | ||||
|   removed unnecessary assignment to FRecvBuffer.Size | ||||
| 
 | ||||
|     Rev 1.12    6/29/2003 10:56:28 PM  BGooijen | ||||
|   Removed .Memory from the buffer, and added some extra methods | ||||
| 
 | ||||
|   Rev 1.11    2003.06.25 4:28:32 PM  czhower | ||||
|   Formatting and fixed a short circuit clause. | ||||
| 
 | ||||
|     Rev 1.10    6/3/2003 11:43:52 PM  BGooijen | ||||
|   Elimintated some code | ||||
| 
 | ||||
|     Rev 1.9    4/16/2003 3:31:26 PM  BGooijen | ||||
|   Removed InternalCheckForDisconnect, added .Connected | ||||
| 
 | ||||
|     Rev 1.8    4/14/2003 11:44:20 AM  BGooijen | ||||
|   CheckForDisconnect calls ReadFromSource now | ||||
| 
 | ||||
|     Rev 1.7    4/2/2003 3:24:56 PM  BGooijen | ||||
|   Moved transparantproxy from ..stack to ..socket | ||||
| 
 | ||||
|     Rev 1.6    3/5/2003 11:04:32 PM  BGooijen | ||||
|   Fixed Intercept, but the part in WriteBuffer doesn't look really nice yet | ||||
| 
 | ||||
|     Rev 1.5    3/3/2003 11:31:58 PM  BGooijen | ||||
|   fixed stack overflow in .CheckForDisconnect | ||||
| 
 | ||||
|     Rev 1.4    2/26/2003 1:15:40 PM  BGooijen | ||||
|   FBinding is now freed in IdIOHandlerSocket, instead of in IdIOHandlerStack | ||||
| 
 | ||||
|   Rev 1.3    2003.02.25 1:36:12 AM  czhower | ||||
| 
 | ||||
|   Rev 1.2    2002.12.06 11:49:34 PM  czhower | ||||
| 
 | ||||
|   Rev 1.1    12-6-2002 20:10:18  BGooijen | ||||
|   Added IPv6-support | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:45:16 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdIOHandlerStack; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$i IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdGlobal, IdSocketHandle, IdIOHandlerSocket, IdExceptionCore, IdStack, | ||||
|   SysUtils; | ||||
| 
 | ||||
| type | ||||
|   TIdIOHandlerStack = class(TIdIOHandlerSocket) | ||||
|   protected | ||||
|     procedure ConnectClient; override; | ||||
|     function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override; | ||||
|     function WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; override; | ||||
|   public | ||||
|     procedure CheckForDisconnect(ARaiseExceptionIfDisconnected: Boolean = True; | ||||
|       AIgnoreBuffer: Boolean = False); override; | ||||
|     function Connected: Boolean; override; | ||||
|     function Readable(AMSec: Integer = IdTimeoutDefault): Boolean; override; | ||||
|   published | ||||
|     property ReadTimeout; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF USE_VCL_POSIX} | ||||
|   Posix.SysSelect, | ||||
|   Posix.SysTime, | ||||
|   {$ENDIF} | ||||
|   IdAntiFreezeBase, IdResourceStringsCore, IdResourceStrings, IdStackConsts, IdException, | ||||
|   IdTCPConnection, IdComponent, IdIOHandler; | ||||
| 
 | ||||
| type | ||||
|   TIdConnectThread = class(TThread) | ||||
|   protected | ||||
|     FBinding: TIdSocketHandle; | ||||
|     FLastSocketError: Integer; | ||||
|     FExceptionMessage: string; | ||||
|     FExceptionOccured: Boolean; | ||||
|     procedure Execute; override; | ||||
|     procedure DoTerminate; override; | ||||
|   public | ||||
|     constructor Create(ABinding: TIdSocketHandle); reintroduce; | ||||
|     property Terminated; | ||||
|   end; | ||||
| 
 | ||||
| { TIdIOHandlerStack } | ||||
| 
 | ||||
| function TIdIOHandlerStack.Connected: Boolean; | ||||
| begin | ||||
|   ReadFromSource(False, 0, False); | ||||
|   Result := inherited Connected; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerStack.ConnectClient; | ||||
| 
 | ||||
|   procedure DoConnectTimeout(ATimeout: Integer); | ||||
|   var | ||||
|     LSleepTime: Integer; | ||||
|     LThread: TIdConnectThread; | ||||
|   begin | ||||
|     if ATimeout = IdTimeoutDefault then begin | ||||
|       ATimeout := IdTimeoutInfinite; | ||||
|     end; | ||||
|     LThread := TIdConnectThread.Create(Binding); | ||||
|     try | ||||
|       // IndySleep | ||||
|       if TIdAntiFreezeBase.ShouldUse then begin | ||||
|         LSleepTime := IndyMin(GAntiFreeze.IdleTimeOut, 125); | ||||
|       end else begin | ||||
|         LSleepTime := 125; | ||||
|       end; | ||||
| 
 | ||||
|       if ATimeout = IdTimeoutInfinite then begin | ||||
|         while not LThread.Terminated do begin | ||||
|           IndySleep(LSleepTime); | ||||
|           TIdAntiFreezeBase.DoProcess; | ||||
|         end; | ||||
|       end else | ||||
|       begin | ||||
|         // TODO: we need to take the actual clock into account, not just | ||||
|         // decrement by the sleep interval.  If IndySleep() runs longer then | ||||
|         // requested, that would slow down the loop and exceed the original | ||||
|         // timeout that was requested... | ||||
|         while (ATimeout > 0) and (not LThread.Terminated) do begin | ||||
|           IndySleep(IndyMin(ATimeout, LSleepTime)); | ||||
|           TIdAntiFreezeBase.DoProcess; | ||||
|           Dec(ATimeout, IndyMin(ATimeout, LSleepTime)); | ||||
|         end; | ||||
|       end; | ||||
| 
 | ||||
|       if LThread.Terminated then begin | ||||
|         if LThread.FExceptionOccured then begin | ||||
|           // TODO: acquire the actual Exception object from TIdConnectThread and re-raise it here | ||||
|           if LThread.FLastSocketError <> 0 then begin | ||||
|             raise EIdSocketError.CreateError(LThread.FLastSocketError, LThread.FExceptionMessage); | ||||
|           end; | ||||
|           raise EIdConnectException.Create(LThread.FExceptionMessage); | ||||
|         end; | ||||
|       end else begin | ||||
|         LThread.Terminate; | ||||
|         Close; | ||||
|         LThread.WaitFor; | ||||
|         raise EIdConnectTimeout.Create(RSConnectTimeout); | ||||
|       end; | ||||
|     finally | ||||
|       LThread.Free; | ||||
|     end; | ||||
|   end; | ||||
| 
 | ||||
| var | ||||
|   LHost: String; | ||||
|   LPort: Integer; | ||||
|   LIP: string; | ||||
|   LIPVersion : TIdIPVersion; | ||||
| begin | ||||
|   inherited ConnectClient; | ||||
|   if Assigned(FTransparentProxy) then begin | ||||
|     if FTransparentProxy.Enabled then begin | ||||
|       LHost := FTransparentProxy.Host; | ||||
|       LPort := FTransparentProxy.Port; | ||||
|       LIPVersion := FTransparentProxy.IPVersion; | ||||
|     end else begin | ||||
|       LHost := Host; | ||||
|       LPort := Port; | ||||
|       LIPVersion := IPVersion; | ||||
|     end; | ||||
|   end else begin | ||||
|     LHost := Host; | ||||
|     LPort := Port; | ||||
|     LIPVersion := IPVersion; | ||||
|   end; | ||||
|   if LIPVersion = Id_IPv4 then | ||||
|   begin | ||||
|     if not GStack.IsIP(LHost) then begin | ||||
|       if Assigned(OnStatus) then begin | ||||
|         DoStatus(hsResolving, [LHost]); | ||||
|       end; | ||||
|       LIP := GStack.ResolveHost(LHost, LIPVersion); | ||||
|     end else begin | ||||
|       LIP := LHost; | ||||
|     end; | ||||
|   end | ||||
|   else | ||||
|   begin  //IPv6 | ||||
|     LIP := MakeCanonicalIPv6Address(LHost); | ||||
|     if LIP='' then begin  //if MakeCanonicalIPv6Address failed, we have a hostname | ||||
|       if Assigned(OnStatus) then begin | ||||
|         DoStatus(hsResolving, [LHost]); | ||||
|       end; | ||||
|       LIP := GStack.ResolveHost(LHost, LIPVersion); | ||||
|     end else begin | ||||
|       LIP := LHost; | ||||
|     end; | ||||
|   end; | ||||
|   Binding.SetPeer(LIP, LPort, LIPVersion); | ||||
|   // Connect | ||||
|   //note for status events, we check specifically for them here | ||||
|   //so we don't do a string conversion in Binding.PeerIP. | ||||
|   if Assigned(OnStatus) then begin | ||||
|     DoStatus(hsConnecting, [Binding.PeerIP]); | ||||
|   end; | ||||
| 
 | ||||
|   if ConnectTimeout = 0 then begin | ||||
|     if TIdAntiFreezeBase.ShouldUse then begin | ||||
|       DoConnectTimeout(120000); // 2 Min | ||||
|     end else begin | ||||
|       Binding.Connect; | ||||
|     end; | ||||
|   end else begin | ||||
|     DoConnectTimeout(ConnectTimeout); | ||||
|   end; | ||||
|   if Assigned(FTransparentProxy) then begin | ||||
|     if FTransparentProxy.Enabled then begin | ||||
|       FTransparentProxy.Connect(Self, Host, Port, IPVersion); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerStack.Readable(AMSec: integer): boolean; | ||||
| begin | ||||
|   Result := Binding.Readable(AMSec); | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerStack.WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; | ||||
| begin | ||||
|   Assert(Binding<>nil); | ||||
|   Result := Binding.Send(ABuffer, AOffset, ALength); | ||||
| end; | ||||
| 
 | ||||
| // Reads any data in tcp/ip buffer and puts it into Indy buffer | ||||
| // This must be the ONLY raw read from Winsock routine | ||||
| // This must be the ONLY call to RECV - all data goes thru this method | ||||
| function TIdIOHandlerStack.ReadDataFromSource(var VBuffer: TIdBytes): Integer; | ||||
| begin | ||||
|   Assert(Binding<>nil); | ||||
|   Result := Binding.Receive(VBuffer); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerStack.CheckForDisconnect( | ||||
|   ARaiseExceptionIfDisconnected: Boolean; AIgnoreBuffer: Boolean); | ||||
| var | ||||
|   LDisconnected: Boolean; | ||||
| begin | ||||
|   // ClosedGracefully // Server disconnected | ||||
|   // IOHandler = nil // Client disconnected | ||||
|   if ClosedGracefully then begin | ||||
|     if BindingAllocated then begin | ||||
|       Close; | ||||
|       // Call event handlers to inform the user that we were disconnected | ||||
|       DoStatus(hsDisconnected); | ||||
|       //DoOnDisconnected; | ||||
|     end; | ||||
|     LDisconnected := True; | ||||
|   end else begin | ||||
|     LDisconnected := not BindingAllocated; | ||||
|   end; | ||||
|   // Do not raise unless all data has been read by the user | ||||
|   if LDisconnected then begin | ||||
|     if (InputBufferIsEmpty or AIgnoreBuffer) and ARaiseExceptionIfDisconnected then begin | ||||
|       RaiseConnClosedGracefully; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| { TIdConnectThread } | ||||
| 
 | ||||
| constructor TIdConnectThread.Create(ABinding: TIdSocketHandle); | ||||
| begin | ||||
|   FBinding := ABinding; | ||||
|   inherited Create(False); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdConnectThread.Execute; | ||||
| begin | ||||
|   try | ||||
|     FBinding.Connect; | ||||
|   except | ||||
|     on E: Exception do begin | ||||
|       // TODO: acquire the actual Exception object and re-raise it in TIdIOHandlerStack.ConnectClient() | ||||
|       FExceptionOccured := True; | ||||
|       FExceptionMessage := E.Message; | ||||
|       if E is EIdSocketError then begin | ||||
|         if (EIdSocketError(E).LastError <> Id_WSAEBADF) and (EIdSocketError(E).LastError <> Id_WSAENOTSOCK) then begin | ||||
|           FLastSocketError := EIdSocketError(E).LastError; | ||||
|         end; | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdConnectThread.DoTerminate; | ||||
| begin | ||||
|   // Necessary as caller checks this | ||||
|   Terminate; | ||||
|   inherited; | ||||
| end; | ||||
| 
 | ||||
| initialization | ||||
|   TIdIOHandlerStack.SetDefaultClass; | ||||
| end. | ||||
							
								
								
									
										332
									
								
								indy/Core/IdIOHandlerStream.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,332 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.21    3/10/05 3:24:30 PM  RLebeau | ||||
|   Updated ReadFromSource() and WriteDirect() to access the Intercept property | ||||
|   directly. | ||||
| 
 | ||||
|   Rev 1.20    10/21/2004 11:07:30 PM  BGooijen | ||||
|   works in win32 now too | ||||
| 
 | ||||
|   Rev 1.19    10/21/2004 1:52:56 PM  BGooijen | ||||
|   Raid 214235 | ||||
| 
 | ||||
|   Rev 1.18    7/23/04 6:20:52 PM  RLebeau | ||||
|   Removed memory leaks in Send/ReceiveStream property setters | ||||
| 
 | ||||
|   Rev 1.17    2004.05.20 11:39:08 AM  czhower | ||||
|   IdStreamVCL | ||||
| 
 | ||||
|   Rev 1.16    23/04/2004 20:29:36  CCostelloe | ||||
|   Minor change to support IdMessageClient's new TIdIOHandlerStreamMsg | ||||
| 
 | ||||
|   Rev 1.15    2004.04.16 11:30:32 PM  czhower | ||||
|   Size fix to IdBuffer, optimizations, and memory leaks | ||||
| 
 | ||||
|   Rev 1.14    2004.04.08 3:56:36 PM  czhower | ||||
|   Fixed bug with Intercept byte count. Also removed Bytes from Buffer. | ||||
| 
 | ||||
|   Rev 1.13    2004.03.07 11:48:46 AM  czhower | ||||
|   Flushbuffer fix + other minor ones found | ||||
| 
 | ||||
|   Rev 1.12    2004.03.03 11:55:04 AM  czhower | ||||
|   IdStream change | ||||
| 
 | ||||
|   Rev 1.11    2004.02.03 4:17:16 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.10    11/01/2004 19:52:44  CCostelloe | ||||
|   Revisions for TIdMessage SaveToFile & LoadFromFile for D7 & D8 | ||||
| 
 | ||||
|   Rev 1.8    08/01/2004 23:37:16  CCostelloe | ||||
|   Minor changes | ||||
| 
 | ||||
|   Rev 1.7    1/8/2004 1:01:22 PM  BGooijen | ||||
|   Cleaned up | ||||
| 
 | ||||
|   Rev 1.6    1/8/2004 4:23:06 AM  BGooijen | ||||
|   temp fixed TIdIOHandlerStream.WriteToDestination | ||||
| 
 | ||||
|   Rev 1.5    08/01/2004 00:25:22  CCostelloe | ||||
|   Start of reimplementing LoadFrom/SaveToFile | ||||
| 
 | ||||
|   Rev 1.4    2003.12.31 7:44:54 PM  czhower | ||||
|   Matched constructors visibility to ancestor. | ||||
| 
 | ||||
|   Rev 1.3    2003.10.24 10:44:54 AM  czhower | ||||
|   IdStream implementation, bug fixes. | ||||
| 
 | ||||
|   Rev 1.2    2003.10.14 11:19:14 PM  czhower | ||||
|   Updated for better functionality. | ||||
| 
 | ||||
|   Rev 1.1    2003.10.14 1:27:14 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.0    2003.10.13 6:40:40 PM  czhower | ||||
|   Moved from root | ||||
| 
 | ||||
|   Rev 1.9    2003.10.11 10:00:36 PM  czhower | ||||
|   Compiles again. | ||||
| 
 | ||||
|   Rev 1.8    10/10/2003 10:53:42 PM  BGooijen | ||||
|   Changed const-ness of some methods to reflect base class changes | ||||
| 
 | ||||
|   Rev 1.7    7/10/2003 6:07:58 PM  SGrobety | ||||
|   .net | ||||
| 
 | ||||
|   Rev 1.6    17/07/2003 00:01:24  CCostelloe | ||||
|   Added (empty) procedures for the base classes' abstract CheckForDataOnSource | ||||
|   and CheckForDisconnect | ||||
| 
 | ||||
|     Rev 1.5    7/1/2003 12:45:56 PM  BGooijen | ||||
|   changed FInputBuffer.Size := 0 to FInputBuffer.Clear | ||||
| 
 | ||||
|   Rev 1.4    12-8-2002 21:05:28  BGooijen | ||||
|   Removed call to Close in .Destroy, this is already done in | ||||
|   TIdIOHandler.Destroy | ||||
| 
 | ||||
|   Rev 1.3    12/7/2002 06:42:44 PM  JPMugaas | ||||
|   These should now compile except for Socks server.  IPVersion has to be a | ||||
|   property someplace for that. | ||||
| 
 | ||||
|   Rev 1.2    12/5/2002 02:53:52 PM  JPMugaas | ||||
|   Updated for new API definitions. | ||||
| 
 | ||||
|   Rev 1.1    05/12/2002 15:29:16  AO'Neill | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:55:08 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdIOHandlerStream; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdBaseComponent, | ||||
|   IdGlobal, | ||||
|   IdIOHandler, | ||||
|   IdStream; | ||||
| 
 | ||||
| type | ||||
|   TIdIOHandlerStream = class; | ||||
|   TIdIOHandlerStreamType = (stRead, stWrite, stReadWrite); | ||||
|   TIdOnGetStreams = procedure(ASender: TIdIOHandlerStream; | ||||
|     var VReceiveStream: TStream; var VSendStream: TStream) of object; | ||||
| 
 | ||||
|   TIdIOHandlerStream = class(TIdIOHandler) | ||||
|   protected | ||||
|     FFreeStreams: Boolean; | ||||
|     FOnGetStreams: TIdOnGetStreams; | ||||
|     FReceiveStream: TStream; | ||||
|     FSendStream: TStream; | ||||
|     FStreamType: TIdIOHandlerStreamType; | ||||
|     // | ||||
|     procedure InitComponent; override; | ||||
|     function ReadDataFromSource(var VBuffer: TIdBytes): Integer; override; | ||||
|     function WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; override; | ||||
|     function SourceIsAvailable: Boolean; override; | ||||
|     function CheckForError(ALastResult: Integer): Integer; override; | ||||
|     procedure RaiseError(AError: Integer); override; | ||||
|   public | ||||
|     function StreamingAvailable: Boolean; | ||||
|     procedure CheckForDisconnect(ARaiseExceptionIfDisconnected: Boolean = True; | ||||
|       AIgnoreBuffer: Boolean = False); override; | ||||
|     constructor Create(AOwner: TComponent; AReceiveStream: TStream; ASendStream: TStream = nil); reintroduce; overload; virtual; | ||||
|     constructor Create(AOwner: TComponent); reintroduce; overload; | ||||
|     function Connected: Boolean; override; | ||||
|     procedure Close; override; | ||||
|     procedure Open; override; | ||||
|     function Readable(AMSec: integer = IdTimeoutDefault): boolean; override; | ||||
|     // | ||||
|     property ReceiveStream: TStream read FReceiveStream; | ||||
|     property SendStream: TStream read FSendStream; | ||||
|     property StreamType: TIdIOHandlerStreamType read FStreamType; | ||||
|   published | ||||
|     property FreeStreams: Boolean read FFreeStreams write FFreeStreams default True; | ||||
|     // | ||||
|     property OnGetStreams: TIdOnGetStreams read FOnGetStreams write FOnGetStreams; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdException, IdComponent, SysUtils; | ||||
| 
 | ||||
| { TIdIOHandlerStream } | ||||
| 
 | ||||
| procedure TIdIOHandlerStream.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FDefStringEncoding := IndyTextEncoding_8Bit; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerStream.CheckForDisconnect( | ||||
|   ARaiseExceptionIfDisconnected: Boolean = True; | ||||
|   AIgnoreBuffer: Boolean = False); | ||||
| var | ||||
|   LDisconnected: Boolean; | ||||
| begin | ||||
|   // ClosedGracefully // Server disconnected | ||||
|   // IOHandler = nil // Client disconnected | ||||
|   if ClosedGracefully then begin | ||||
|     if StreamingAvailable then begin | ||||
|       Close; | ||||
|       // Call event handlers to inform the user that we were disconnected | ||||
|       DoStatus(hsDisconnected); | ||||
|       //DoOnDisconnected; | ||||
|     end; | ||||
|     LDisconnected := True; | ||||
|   end else begin | ||||
|     LDisconnected := not StreamingAvailable; | ||||
|   end; | ||||
|   // Do not raise unless all data has been read by the user | ||||
|   if LDisconnected then begin | ||||
|     if (InputBufferIsEmpty or AIgnoreBuffer) and ARaiseExceptionIfDisconnected then begin | ||||
|       RaiseConnClosedGracefully; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerStream.Close; | ||||
| begin | ||||
|   inherited Close; | ||||
|   if FreeStreams then begin | ||||
|     FreeAndNil(FReceiveStream); | ||||
|     FreeAndNil(FSendStream); | ||||
|   end else begin | ||||
|     FReceiveStream := nil; | ||||
|     FSendStream := nil; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerStream.StreamingAvailable: Boolean; | ||||
| begin | ||||
|   Result := False;  // Just to avoid warning message | ||||
|   case FStreamType of | ||||
|     stRead: Result := Assigned(ReceiveStream); | ||||
|     stWrite: Result := Assigned(SendStream); | ||||
|     stReadWrite: Result := Assigned(ReceiveStream) and Assigned(SendStream); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerStream.Connected: Boolean; | ||||
| begin | ||||
|   Result := (StreamingAvailable and inherited Connected) or (not InputBufferIsEmpty); | ||||
| end; | ||||
| 
 | ||||
| constructor TIdIOHandlerStream.Create(AOwner: TComponent); | ||||
| begin | ||||
|   inherited Create(AOwner); | ||||
|   FFreeStreams := True; | ||||
|   FStreamType := stReadWrite; | ||||
| end; | ||||
| 
 | ||||
| constructor TIdIOHandlerStream.Create(AOwner: TComponent; AReceiveStream: TStream; | ||||
|   ASendStream: TStream = nil); | ||||
| begin | ||||
|   inherited Create(AOwner); | ||||
|   // | ||||
|   FFreeStreams := True; | ||||
|   FReceiveStream := AReceiveStream; | ||||
|   FSendStream := ASendStream; | ||||
|   // | ||||
|   if Assigned(FReceiveStream) and (not Assigned(FSendStream)) then begin | ||||
|     FStreamType := stRead; | ||||
|   end else if (not Assigned(FReceiveStream)) and Assigned(FSendStream) then begin | ||||
|     FStreamType := stWrite; | ||||
|   end else begin | ||||
|     FStreamType := stReadWrite; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerStream.Open; | ||||
| begin | ||||
|   inherited Open; | ||||
|   if Assigned(OnGetStreams) then begin | ||||
|     OnGetStreams(Self, FReceiveStream, FSendStream); | ||||
|   end; | ||||
|   if Assigned(FReceiveStream) and (not Assigned(FSendStream)) then begin | ||||
|     FStreamType := stRead; | ||||
|   end else if (not Assigned(FReceiveStream)) and Assigned(FSendStream) then begin | ||||
|     FStreamType := stWrite; | ||||
|   end else begin | ||||
|     FStreamType := stReadWrite; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerStream.Readable(AMSec: Integer): Boolean; | ||||
| begin | ||||
|   Result := Assigned(ReceiveStream); | ||||
|   // RLebeau: not checking the Position anymore. Was | ||||
|   // causing deadlocks when trying to read past EOF. | ||||
|   // This way, when EOF is reached, ReadFromSource() | ||||
|   // will return 0, which will be interpretted as the | ||||
|   // connnection being closed... | ||||
|   { | ||||
|   if Result then begin | ||||
|     Result := ReceiveStream.Position < ReceiveStream.Size; | ||||
|   end; | ||||
|   } | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerStream.ReadDataFromSource(var VBuffer: TIdBytes): Integer; | ||||
| begin | ||||
|   // We dont want to read the whole stream in at a time. If its a big | ||||
|   // file will consume way too much memory by loading it all at once. | ||||
|   // So lets read it in chunks. | ||||
|   if Assigned(FReceiveStream) then begin | ||||
|     Result := IndyMin(32 * 1024, Length(VBuffer)); | ||||
|     if Result > 0 then begin | ||||
|       Result := TIdStreamHelper.ReadBytes(FReceiveStream, VBuffer, Result); | ||||
|     end; | ||||
|   end else begin | ||||
|     Result := 0; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerStream.WriteDataToTarget(const ABuffer: TIdBytes; const AOffset, ALength: Integer): Integer; | ||||
| begin | ||||
|   if Assigned(FSendStream) then begin | ||||
|     Result := TIdStreamHelper.Write(FSendStream, ABuffer, ALength, AOffset); | ||||
|   end else begin | ||||
|     Result := IndyLength(ABuffer, ALength, AOffset); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerStream.SourceIsAvailable: Boolean; | ||||
| begin | ||||
|   Result := Assigned(ReceiveStream); | ||||
| end; | ||||
| 
 | ||||
| function TIdIOHandlerStream.CheckForError(ALastResult: Integer): Integer; | ||||
| begin | ||||
|   Result := ALastResult; | ||||
|   if Result < 0 then begin | ||||
|     raise EIdException.Create('Stream error'); {do not localize} | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIOHandlerStream.RaiseError(AError: Integer); | ||||
| begin | ||||
|   raise EIdException.Create('Stream error'); {do not localize} | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										293
									
								
								indy/Core/IdIPAddress.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,293 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.10    2/8/05 5:29:16 PM  RLebeau | ||||
|   Updated GetHToNBytes() to use CopyTIdWord() instead of AppendBytes() for IPv6 | ||||
|   addresses. | ||||
| 
 | ||||
|   Rev 1.9    28.09.2004 20:54:32  Andreas Hausladen | ||||
|   Removed unused functions that were moved to IdGlobal | ||||
| 
 | ||||
|   Rev 1.8    6/11/2004 8:48:20 AM  DSiders | ||||
|   Added "Do not Localize" comments. | ||||
| 
 | ||||
|   Rev 1.7    5/19/2004 10:44:34 PM  DSiders | ||||
|   Corrected spelling for TIdIPAddress.MakeAddressObject method. | ||||
| 
 | ||||
|   Rev 1.6    14/04/2004 17:35:38  HHariri | ||||
|   Removed IP6 for BCB temporarily | ||||
| 
 | ||||
|   Rev 1.5    2/11/2004 5:10:40 AM  JPMugaas | ||||
|   Moved IPv6 address definition to System package. | ||||
| 
 | ||||
|   Rev 1.4    2004.02.03 4:17:18 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.3    2/2/2004 12:22:24 PM  JPMugaas | ||||
|   Now uses IdGlobal IPVersion Type.  Added HToNBytes for things that need | ||||
|   to export into NetworkOrder for structures used in protocols. | ||||
| 
 | ||||
|   Rev 1.2    1/3/2004 2:13:56 PM  JPMugaas | ||||
|   Removed some empty function code that wasn't used. | ||||
|   Added some value comparison functions. | ||||
|   Added a function in the IPAddress object for comparing the value with another | ||||
|   IP address.  Note that this comparison is useful as an IP address will take | ||||
|   several forms (especially common with IPv6). | ||||
|   Added a property for returning the IP address as a string which works for | ||||
|   both IPv4 and IPv6 addresses. | ||||
| 
 | ||||
|   Rev 1.1    1/3/2004 1:03:14 PM  JPMugaas | ||||
|   Removed Lo as it was not needed and is not safe in NET. | ||||
| 
 | ||||
|   Rev 1.0    1/1/2004 4:00:18 PM  JPMugaas | ||||
|   An object for handling both IPv4 and IPv6 addresses.  This is a proposal with | ||||
|   some old code for conversions. | ||||
| } | ||||
| 
 | ||||
| unit IdIPAddress; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //we need to put this in Delphi mode to work | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdGlobal; | ||||
| 
 | ||||
| type | ||||
|   TIdIPAddress = class(TObject) | ||||
|   protected | ||||
|     FIPv4 : UInt32; | ||||
|     FAddrType : TIdIPVersion; | ||||
|     //general conversion stuff | ||||
|     //property as String Get methods | ||||
|     function GetIPv4AsString : String; | ||||
|     function GetIPv6AsString : String; | ||||
|     function GetIPAddress : String; | ||||
|   public | ||||
|     //We can't make this into a property for C++Builder | ||||
|     IPv6 : TIdIPv6Address; | ||||
| 
 | ||||
|     constructor Create; virtual; | ||||
|     class function MakeAddressObject(const AIP : String) : TIdIPAddress; overload; | ||||
|     class function MakeAddressObject(const AIP : String; const AIPVersion: TIdIPVersion) : TIdIPAddress; overload; | ||||
|     function CompareAddress(const AIP : String; var VErr : Boolean) : Integer; | ||||
|     function HToNBytes: TIdBytes; | ||||
| 
 | ||||
|     property IPv4 : UInt32 read FIPv4 write FIPv4; | ||||
|     property IPv4AsString : String read GetIPv4AsString; | ||||
|     property IPv6AsString : String read GetIPv6AsString; | ||||
|     property AddrType : TIdIPVersion read FAddrType write FAddrType; | ||||
|     property IPAsString : String read GetIPAddress; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdStack, SysUtils; | ||||
| 
 | ||||
| //IPv4 address conversion | ||||
| //Much of this is based on http://www.pc-help.org/obscure.htm | ||||
| 
 | ||||
| function CompareUInt16(const AWord1, AWord2 : UInt16) : Integer; | ||||
| {$IFDEF USE_INLINE}inline;{$ENDIF} | ||||
| { | ||||
| AWord1 > AWord2	> 0 | ||||
| AWord1 < AWord2	< 0 | ||||
| AWord1 = AWord2	= 0 | ||||
| } | ||||
| begin | ||||
|   if AWord1 > AWord2 then begin | ||||
|     Result := 1; | ||||
|   end else if AWord1 < AWord2 then begin | ||||
|     Result := -1; | ||||
|   end else begin | ||||
|     Result := 0; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function CompareUInt32(const ACard1, ACard2 : UInt32) : Integer; | ||||
| {$IFDEF USE_INLINE}inline;{$ENDIF} | ||||
| { | ||||
| ACard1 > ACard2	> 0 | ||||
| ACard1 < ACard2	< 0 | ||||
| ACard1 = ACard2	= 0 | ||||
| } | ||||
| begin | ||||
|   if ACard1 > ACard2 then begin | ||||
|     Result := 1; | ||||
|   end else if ACard1 < ACard2 then begin | ||||
|     Result := -1; | ||||
|   end else begin | ||||
|     Result := 0; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| { TIdIPAddress } | ||||
| 
 | ||||
| function TIdIPAddress.CompareAddress(const AIP: String; var VErr: Boolean): Integer; | ||||
| var | ||||
|   LIP2 : TIdIPAddress; | ||||
|   i : Integer; | ||||
| { | ||||
| Note that the IP address in the object is S1. | ||||
| S1 > S2	> 0 | ||||
| S1 < S2	< 0 | ||||
| S1 = S2	= 0 | ||||
| } | ||||
| begin | ||||
|   Result := 0; | ||||
|   //LIP2 may be nil if the IP address is invalid | ||||
|   LIP2 := MakeAddressObject(AIP); | ||||
|   VErr := not Assigned(LIP2); | ||||
|   if not VErr then begin | ||||
|     try | ||||
|       // we can't compare an IPv4 address with an IPv6 address | ||||
|       VErr := FAddrType <> LIP2.FAddrType; | ||||
|       if not VErr then begin | ||||
|         if FAddrType = Id_IPv4 then begin | ||||
|           Result := CompareUInt32(FIPv4, LIP2.FIPv4); | ||||
|         end else begin | ||||
|           for I := 0 to 7 do begin | ||||
|             Result := CompareUInt16(IPv6[i], LIP2.IPv6[i]); | ||||
|             if Result <> 0 then begin | ||||
|               Break; | ||||
|             end; | ||||
|           end; | ||||
|         end; | ||||
|       end; | ||||
|     finally | ||||
|       FreeAndNil(LIP2); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| constructor TIdIPAddress.Create; | ||||
| begin | ||||
|   inherited Create; | ||||
|   FAddrType := Id_IPv4; | ||||
|   FIPv4 := 0; //'0.0.0.0' | ||||
| end; | ||||
| 
 | ||||
| function TIdIPAddress.HToNBytes: TIdBytes; | ||||
| var | ||||
|   I : Integer; | ||||
| begin | ||||
|   if FAddrType = Id_IPv4 then begin | ||||
|     Result := ToBytes(GStack.HostToNetwork(FIPv4)); | ||||
|   end else begin | ||||
|     SetLength(Result, 16); | ||||
|     for I := 0 to 7 do begin | ||||
|       CopyTIdUInt16(GStack.HostToNetwork(IPv6[i]), Result, 2*I); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIPAddress.GetIPAddress: String; | ||||
| begin | ||||
|   if FAddrType = Id_IPv4 then begin | ||||
|     Result := GetIPv4AsString; | ||||
|   end else begin | ||||
|     Result := GetIPv6AsString; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIPAddress.GetIPv4AsString: String; | ||||
| begin | ||||
|   if FAddrType = Id_IPv4 then begin | ||||
|     Result := IntToStr((FIPv4 shr 24) and $FF) + '.'; | ||||
|     Result := Result + IntToStr((FIPv4 shr 16) and $FF) + '.'; | ||||
|     Result := Result + IntToStr((FIPv4 shr 8) and $FF) + '.'; | ||||
|     Result := Result + IntToStr(FIPv4 and $FF); | ||||
|   end else begin | ||||
|     Result := ''; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIPAddress.GetIPv6AsString: String; | ||||
| var | ||||
|   I: Integer; | ||||
| begin | ||||
|   if FAddrType = Id_IPv6 then begin | ||||
|     Result := IntToHex(IPv6[0], 4); | ||||
|     for i := 1 to 7 do begin | ||||
|       Result := Result + ':' + IntToHex(IPv6[i], 4); | ||||
|     end; | ||||
|   end else begin | ||||
|     Result := ''; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| class function TIdIPAddress.MakeAddressObject(const AIP: String): TIdIPAddress; | ||||
| var | ||||
|   LErr : Boolean; | ||||
| begin | ||||
|   Result := TIdIPAddress.Create; | ||||
|   try | ||||
|     IPv6ToIdIPv6Address(AIP, Result.IPv6, LErr); | ||||
|     if not LErr then begin | ||||
|       Result.FAddrType := Id_IPv6; | ||||
|       Exit; | ||||
|     end; | ||||
|     Result.FIPv4 := IPv4ToUInt32(AIP, LErr); | ||||
|     if not LErr then begin | ||||
|       Result.FAddrType := Id_IPv4; | ||||
|       Exit; | ||||
|     end; | ||||
|     //this is not a valid IP address | ||||
|     FreeAndNil(Result); | ||||
|   except | ||||
|     FreeAndNil(Result); | ||||
|     raise; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| class function TIdIPAddress.MakeAddressObject(const AIP: String; const AIPVersion: TIdIPVersion): TIdIPAddress; | ||||
| var | ||||
|   LErr : Boolean; | ||||
| begin | ||||
|   Result := TIdIPAddress.Create; | ||||
|   try | ||||
|     case AIPVersion of | ||||
|       Id_IPV4: | ||||
|         begin | ||||
|           Result.FIPv4 := IPv4ToUInt32(AIP, LErr); | ||||
|           if not LErr then begin | ||||
|             Result.FAddrType := Id_IPv4; | ||||
|             Exit; | ||||
|           end; | ||||
|         end; | ||||
|       Id_IPv6: | ||||
|         begin | ||||
|           IPv6ToIdIPv6Address(AIP, Result.IPv6, LErr); | ||||
|           if not LErr then begin | ||||
|             Result.FAddrType := Id_IPv6; | ||||
|             Exit; | ||||
|           end | ||||
|         end; | ||||
|     end; | ||||
|     //this is not a valid IP address | ||||
|     FreeAndNil(Result); | ||||
|   except | ||||
|     FreeAndNil(Result); | ||||
|     raise; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										257
									
								
								indy/Core/IdIPMCastBase.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,257 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.4    2004.02.03 5:43:52 PM  czhower | ||||
|   Name changes | ||||
| 
 | ||||
|   Rev 1.3    1/21/2004 3:11:06 PM  JPMugaas | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.2    10/26/2003 09:11:50 AM  JPMugaas | ||||
|   Should now work in NET. | ||||
| 
 | ||||
|   Rev 1.1    2003.10.12 4:03:56 PM  czhower | ||||
|   compile todos | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:55:16 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdIPMCastBase; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //here to flip FPC into Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS} | ||||
|   Classes, | ||||
|   {$ENDIF} | ||||
|   IdComponent, IdException, IdGlobal, IdSocketHandle, | ||||
|   IdStack; | ||||
| 
 | ||||
| (*$HPPEMIT '#if defined(_VCL_ALIAS_RECORDS)' *) | ||||
| (*$HPPEMIT '#if !defined(UNICODE)' *) | ||||
| (*$HPPEMIT '#pragma alias "@Idipmcastbase@TIdIPMCastBase@SetPortA$qqrxi"="@Idipmcastbase@TIdIPMCastBase@SetPort$qqrxi"' *) | ||||
| (*$HPPEMIT '#else' *) | ||||
| (*$HPPEMIT '#pragma alias "@Idipmcastbase@TIdIPMCastBase@SetPortW$qqrxi"="@Idipmcastbase@TIdIPMCastBase@SetPort$qqrxi"' *) | ||||
| (*$HPPEMIT '#endif' *) | ||||
| (*$HPPEMIT '#endif' *) | ||||
| 
 | ||||
| const | ||||
|   IPMCastLo = 224; | ||||
|   IPMCastHi = 239; | ||||
| 
 | ||||
| type | ||||
|   TIdIPMv6Scope = ( IdIPv6MC_InterfaceLocal, | ||||
| {  Interface-Local scope spans only a single interface on a node | ||||
|    and is useful only for loopback transmission of multicast.} | ||||
|    IdIPv6MC_LinkLocal, | ||||
| {  Link-Local multicast scope spans the same topological region as | ||||
| the corresponding unicast scope. } | ||||
|    IdIPv6MC_AdminLocal, | ||||
| {   Admin-Local scope is the smallest scope that must be | ||||
| administratively configured, i.e., not automatically derived | ||||
| from physical connectivity or other, non-multicast-related | ||||
| configuration.} | ||||
|     IdIPv6MC_SiteLocal, | ||||
| {    Site-Local scope is intended to span a single site.   } | ||||
|     IdIPv6MC_OrgLocal, | ||||
| {Organization-Local scope is intended to span multiple sites | ||||
| belonging to a single organization.} | ||||
|     IdIPv6MC_Global); | ||||
| 
 | ||||
|   TIdIPMCValidScopes = 0..$F; | ||||
| 
 | ||||
|   TIdIPMCastBase = class(TIdComponent) | ||||
|   protected | ||||
|     FDsgnActive: Boolean; | ||||
|     FMulticastGroup: String; | ||||
|     FPort: Integer; | ||||
|     FIPVersion: TIdIPVersion; | ||||
|     FReuseSocket: TIdReuseSocket; | ||||
|     // | ||||
|     procedure CloseBinding; virtual; abstract; | ||||
|     function GetActive: Boolean; virtual; | ||||
|     function GetBinding: TIdSocketHandle; virtual; abstract; | ||||
|     procedure Loaded; override; | ||||
|     procedure SetActive(const Value: Boolean); virtual; | ||||
|     procedure SetMulticastGroup(const Value: string); virtual; | ||||
|     procedure SetPort(const Value: integer); virtual; | ||||
|     function GetIPVersion: TIdIPVersion; virtual; | ||||
|     procedure SetIPVersion(const AValue: TIdIPVersion); virtual; | ||||
|     // | ||||
|     property Active: Boolean read GetActive write SetActive Default False; | ||||
|     property MulticastGroup: string read FMulticastGroup write SetMulticastGroup; | ||||
|     property Port: Integer read FPort write SetPort; | ||||
|     property IPVersion: TIdIPVersion read GetIPVersion write SetIPVersion default ID_DEFAULT_IP_VERSION; | ||||
|     procedure InitComponent; override; | ||||
|   public | ||||
|     {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS} | ||||
|     constructor Create(AOwner: TComponent); reintroduce; overload; | ||||
|     {$ENDIF} | ||||
|     function IsValidMulticastGroup(const Value: string): Boolean; | ||||
| {These two items are helper functions that allow you to specify the scope for | ||||
| a Variable Scope Multicast Addresses.  Some are listed in IdAssignedNumbers | ||||
| as the Id_IPv6MC_V_ constants.  You can't use them out of the box in the | ||||
| MulticastGroup property because you need to specify the scope.  This provides | ||||
| you with more flexibility than you would get with IPv4 multicasting.} | ||||
|     class function SetIPv6AddrScope(const AVarIPv6Addr : String; const AScope : TIdIPMv6Scope ) : String; overload; | ||||
|     class function SetIPv6AddrScope(const AVarIPv6Addr : String; const AScope : TIdIPMCValidScopes): String; overload; | ||||
|     // | ||||
|     property ReuseSocket: TIdReuseSocket read FReuseSocket write FReuseSocket default rsOSDependent; | ||||
|   published | ||||
|   end; | ||||
| 
 | ||||
|   EIdMCastException = Class(EIdException); | ||||
|   EIdMCastNoBindings = class(EIdMCastException); | ||||
|   EIdMCastNotValidAddress = class(EIdMCastException); | ||||
|   EIdMCastReceiveErrorZeroBytes = class(EIdMCastException); | ||||
| 
 | ||||
| const | ||||
|   DEF_IPv6_MGROUP = 'FF01:0:0:0:0:0:0:1'; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdAssignedNumbers, | ||||
|   IdResourceStringsCore, IdStackConsts, SysUtils; | ||||
| 
 | ||||
| { TIdIPMCastBase } | ||||
| 
 | ||||
| {$IFDEF WORKAROUND_INLINE_CONSTRUCTORS} | ||||
| constructor TIdIPMCastBase.Create(AOwner: TComponent); | ||||
| begin | ||||
|   inherited Create(AOwner); | ||||
| end; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| function TIdIPMCastBase.GetIPVersion: TIdIPVersion; | ||||
| begin | ||||
|   Result := FIPVersion; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastBase.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FMultiCastGroup := Id_IPMC_All_Systems; | ||||
|   FIPVersion := ID_DEFAULT_IP_VERSION; | ||||
|   FReuseSocket := rsOSDependent; | ||||
| end; | ||||
| 
 | ||||
| function TIdIPMCastBase.GetActive: Boolean; | ||||
| begin | ||||
|   Result := FDsgnActive; | ||||
| end; | ||||
| 
 | ||||
| function TIdIPMCastBase.IsValidMulticastGroup(const Value: string): Boolean; | ||||
| begin | ||||
| //just here to prevent a warning from Delphi about an unitialized result | ||||
|   Result := False; | ||||
|   case FIPVersion of | ||||
|      Id_IPv4 : Result := GStack.IsValidIPv4MulticastGroup(Value); | ||||
|      Id_IPv6 : Result := GStack.IsValidIPv6MulticastGroup(Value); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastBase.Loaded; | ||||
| var | ||||
|   b: Boolean; | ||||
| begin | ||||
|   inherited Loaded; | ||||
|   b := FDsgnActive; | ||||
|   FDsgnActive := False; | ||||
|   Active := b; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastBase.SetActive(const Value: Boolean); | ||||
| begin | ||||
|   if Active <> Value then begin | ||||
|     if not (IsDesignTime or IsLoading) then begin | ||||
|       if Value then begin | ||||
|         GetBinding; | ||||
|       end | ||||
|       else begin | ||||
|         CloseBinding; | ||||
|       end; | ||||
|     end | ||||
|     else begin  // don't activate at designtime (or during loading of properties)    {Do not Localize} | ||||
|       FDsgnActive := Value; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| class function TIdIPMCastBase.SetIPv6AddrScope(const AVarIPv6Addr: String; | ||||
|   const AScope: TIdIPMv6Scope): String; | ||||
| begin | ||||
| 
 | ||||
|   case AScope of | ||||
|    IdIPv6MC_InterfaceLocal : Result := SetIPv6AddrScope(AVarIPv6Addr,$1); | ||||
|         IdIPv6MC_LinkLocal : Result := SetIPv6AddrScope(AVarIPv6Addr,$2); | ||||
|        IdIPv6MC_AdminLocal : Result := SetIPv6AddrScope(AVarIPv6Addr,$4); | ||||
|         IdIPv6MC_SiteLocal : Result := SetIPv6AddrScope(AVarIPv6Addr,$5); | ||||
|          IdIPv6MC_OrgLocal : Result := SetIPv6AddrScope(AVarIPv6Addr,$8); | ||||
|            IdIPv6MC_Global : Result := SetIPv6AddrScope(AVarIPv6Addr,$E); | ||||
|   else | ||||
|     Result := AVarIPv6Addr; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| class function TIdIPMCastBase.SetIPv6AddrScope(const AVarIPv6Addr: String; | ||||
|   const AScope: TIdIPMCValidScopes): String; | ||||
| begin | ||||
|    //Replace the X in the Id_IPv6MC_V_ constants with the specified scope | ||||
|    Result := ReplaceOnlyFirst(AVarIPv6Addr,'X',IntToHex(AScope,1)); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastBase.SetIPVersion(const AValue: TIdIPVersion); | ||||
| begin | ||||
|   if AValue <> IPVersion then | ||||
|   begin | ||||
|     Active := False; | ||||
|     FIPVersion := AValue; | ||||
|     case AValue of | ||||
|        Id_IPv4: FMulticastGroup := Id_IPMC_All_Systems; | ||||
|        Id_IPv6: FMulticastGroup := DEF_IPv6_MGROUP; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastBase.SetMulticastGroup(const Value: string); | ||||
| begin | ||||
|   if (FMulticastGroup <> Value) then begin | ||||
|     if IsValidMulticastGroup(Value) then | ||||
|     begin | ||||
|       Active := False; | ||||
|       FMulticastGroup := Value; | ||||
|     end else | ||||
|     begin | ||||
|       Raise EIdMCastNotValidAddress.Create(RSIPMCastInvalidMulticastAddress); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastBase.SetPort(const Value: integer); | ||||
| begin | ||||
|   if FPort <> Value then begin | ||||
|     Active := False; | ||||
|     FPort := Value; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										312
									
								
								indy/Core/IdIPMCastClient.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,312 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.6    14/06/2004 21:38:28  CCostelloe | ||||
|   Converted StringToTIn4Addr call | ||||
| 
 | ||||
|   Rev 1.5    09/06/2004 10:00:34  CCostelloe | ||||
|   Kylix 3 patch | ||||
| 
 | ||||
|   Rev 1.4    2004.02.03 5:43:52 PM  czhower | ||||
|   Name changes | ||||
| 
 | ||||
|   Rev 1.3    1/21/2004 3:11:08 PM  JPMugaas | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.2    10/26/2003 09:11:52 AM  JPMugaas | ||||
|   Should now work in NET. | ||||
| 
 | ||||
|   Rev 1.1    2003.10.12 4:03:56 PM  czhower | ||||
|   compile todos | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:55:22 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdIPMCastClient; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF VCL_2010_OR_ABOVE} | ||||
|   Classes,    //here to facilitate inlining | ||||
|   {$ENDIF} | ||||
|   IdException, | ||||
|   IdGlobal, | ||||
|   IdIPMCastBase, | ||||
|   IdUDPBase, | ||||
|   IdComponent, | ||||
|   IdSocketHandle, | ||||
|   IdThread; | ||||
| 
 | ||||
| const | ||||
|   DEF_IMP_THREADEDEVENT = False; | ||||
| 
 | ||||
| type | ||||
|   TIPMCastReadEvent = procedure(Sender: TObject; const AData: TIdBytes; ABinding: TIdSocketHandle) of object; | ||||
| 
 | ||||
|   TIdIPMCastClient = class; | ||||
| 
 | ||||
|   TIdIPMCastListenerThread = class(TIdThread) | ||||
|   protected | ||||
|     IncomingData: TIdSocketHandle; | ||||
|     FAcceptWait: integer; | ||||
|     FBuffer: TIdBytes; | ||||
|     FBufferSize: integer; | ||||
|     procedure Run; override; | ||||
|   public | ||||
|     FServer: TIdIPMCastClient; | ||||
|     // | ||||
|     constructor Create(AOwner: TIdIPMCastClient); reintroduce; | ||||
|     destructor Destroy; override; | ||||
| 
 | ||||
|     procedure IPMCastRead; | ||||
|     // | ||||
|     property AcceptWait: integer read FAcceptWait write FAcceptWait; | ||||
|   end; | ||||
| 
 | ||||
|   TIdIPMCastClient = class(TIdIPMCastBase) | ||||
|   protected | ||||
|     FBindings: TIdSocketHandles; | ||||
|     FBufferSize: Integer; | ||||
|     FCurrentBinding: TIdSocketHandle; | ||||
|     FListenerThread: TIdIPMCastListenerThread; | ||||
|     FOnIPMCastRead: TIPMCastReadEvent; | ||||
|     FThreadedEvent: boolean; | ||||
|     // | ||||
|     procedure CloseBinding; override; | ||||
|     procedure DoIPMCastRead(const AData: TIdBytes; ABinding: TIdSocketHandle);virtual; | ||||
|     function GetActive: Boolean; override; | ||||
|     function GetBinding: TIdSocketHandle; override; | ||||
|     function GetDefaultPort: integer; | ||||
|     procedure PacketReceived(const AData: TIdBytes; ABinding: TIdSocketHandle); | ||||
|     procedure SetBindings(const Value: TIdSocketHandles); | ||||
|     procedure SetDefaultPort(const AValue: integer); | ||||
|     procedure InitComponent; override; | ||||
|   public | ||||
|     destructor Destroy; override; | ||||
|     // | ||||
|   published | ||||
|     property IPVersion; | ||||
|     property Active; | ||||
|     property Bindings: TIdSocketHandles read FBindings write SetBindings; | ||||
|     property BufferSize: Integer read FBufferSize write FBufferSize default ID_UDP_BUFFERSIZE; | ||||
|     property DefaultPort: integer read GetDefaultPort write SetDefaultPort; | ||||
|     property MulticastGroup; | ||||
|     property ReuseSocket; | ||||
|     property ThreadedEvent: boolean read FThreadedEvent write FThreadedEvent default DEF_IMP_THREADEDEVENT; | ||||
|     property OnIPMCastRead: TIPMCastReadEvent read FOnIPMCastRead write FOnIPMCastRead; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdResourceStringsCore, | ||||
|   IdStack, | ||||
|   IdStackConsts, | ||||
|   SysUtils; | ||||
| 
 | ||||
| { TIdIPMCastClient } | ||||
| 
 | ||||
| procedure TIdIPMCastClient.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   BufferSize := ID_UDP_BUFFERSIZE; | ||||
|   FThreadedEvent := DEF_IMP_THREADEDEVENT; | ||||
|   FBindings := TIdSocketHandles.Create(Self); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastClient.CloseBinding; | ||||
| var | ||||
|   i: integer; | ||||
| begin | ||||
|   if Assigned(FCurrentBinding) then begin | ||||
|     // Necessary here - cancels the recvfrom in the listener thread | ||||
|     FListenerThread.Stop; | ||||
|     try | ||||
|       for i := 0 to Bindings.Count - 1 do begin | ||||
|         if Bindings[i].HandleAllocated then begin | ||||
|           // RLebeau: DropMulticastMembership() can raise an exception if | ||||
|           // the network cable has been pulled out... | ||||
|           // TODO: update DropMulticastMembership() to not raise an exception... | ||||
|           try | ||||
|             Bindings[i].DropMulticastMembership(FMulticastGroup); | ||||
|           except | ||||
|           end; | ||||
|         end; | ||||
|         Bindings[i].CloseSocket; | ||||
|       end; | ||||
|     finally | ||||
|       FListenerThread.WaitFor; | ||||
|       FreeAndNil(FListenerThread); | ||||
|       FCurrentBinding := nil; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastClient.DoIPMCastRead(const AData: TIdBytes; ABinding: TIdSocketHandle); | ||||
| begin | ||||
|   if Assigned(OnIPMCastRead) then begin | ||||
|     OnIPMCastRead(Self, AData, ABinding); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdIPMCastClient.GetActive: Boolean; | ||||
| begin | ||||
|   // inherited GetActive keeps track of design-time Active property | ||||
|   Result := inherited GetActive or | ||||
|             (Assigned(FCurrentBinding) and FCurrentBinding.HandleAllocated); | ||||
| end; | ||||
| 
 | ||||
| function TIdIPMCastClient.GetBinding: TIdSocketHandle; | ||||
| var | ||||
|   i: integer; | ||||
| begin | ||||
|   if not Assigned(FCurrentBinding) then | ||||
|   begin | ||||
|     if Bindings.Count < 1 then begin | ||||
|       if DefaultPort > 0 then begin | ||||
|         Bindings.Add.IPVersion := FIPVersion; | ||||
|       end else begin | ||||
|         raise EIdMCastNoBindings.Create(RSNoBindingsSpecified); | ||||
|       end; | ||||
|     end; | ||||
|     for i := 0 to Bindings.Count - 1 do begin | ||||
|       Bindings[i].AllocateSocket(Id_SOCK_DGRAM); | ||||
|       // do not overwrite if the default. This allows ReuseSocket to be set per binding | ||||
|       if FReuseSocket <> rsOSDependent then begin | ||||
|         Bindings[i].ReuseSocket := FReuseSocket; | ||||
|       end; | ||||
|       Bindings[i].Bind; | ||||
|       Bindings[i].AddMulticastMembership(FMulticastGroup); | ||||
|     end; | ||||
|     FCurrentBinding := Bindings[0]; | ||||
|     FListenerThread := TIdIPMCastListenerThread.Create(Self); | ||||
|     FListenerThread.Start; | ||||
|   end; | ||||
|   Result := FCurrentBinding; | ||||
| end; | ||||
| 
 | ||||
| function TIdIPMCastClient.GetDefaultPort: integer; | ||||
| begin | ||||
|   result := FBindings.DefaultPort; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastClient.PacketReceived(const AData: TIdBytes; ABinding: TIdSocketHandle); | ||||
| begin | ||||
|   FCurrentBinding := ABinding; | ||||
|   DoIPMCastRead(AData, ABinding); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastClient.SetBindings(const Value: TIdSocketHandles); | ||||
| begin | ||||
|   FBindings.Assign(Value); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastClient.SetDefaultPort(const AValue: integer); | ||||
| begin | ||||
|   if (FBindings.DefaultPort <> AValue) then begin | ||||
|     FBindings.DefaultPort := AValue; | ||||
|     FPort := AValue; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdIPMCastClient.Destroy; | ||||
| begin | ||||
|   Active := False; | ||||
|   FreeAndNil(FBindings); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| { TIdIPMCastListenerThread } | ||||
| 
 | ||||
| constructor TIdIPMCastListenerThread.Create(AOwner: TIdIPMCastClient); | ||||
| begin | ||||
|   inherited Create(True); | ||||
|   FAcceptWait := 1000; | ||||
|   FBufferSize := AOwner.BufferSize; | ||||
|   FBuffer := nil; | ||||
|   FServer := AOwner; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdIPMCastListenerThread.Destroy; | ||||
| begin | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastListenerThread.Run; | ||||
| var | ||||
|   PeerIP: string; | ||||
|   PeerPort: TIdPort; | ||||
|   PeerIPVersion: TIdIPVersion; | ||||
|   ByteCount: Integer; | ||||
|   LReadList: TIdSocketList; | ||||
|   i: Integer; | ||||
|   LBuffer : TIdBytes; | ||||
| begin | ||||
|   SetLength(LBuffer, FBufferSize); | ||||
| 
 | ||||
|   // create a socket list to select for read | ||||
|   LReadList := TIdSocketList.CreateSocketList; | ||||
|   try | ||||
|     // fill list of socket handles for reading | ||||
|     for i := 0 to FServer.Bindings.Count - 1 do | ||||
|     begin | ||||
|       LReadList.Add(FServer.Bindings[i].Handle); | ||||
|     end; | ||||
| 
 | ||||
|     // select the handles for reading | ||||
|     LReadList.SelectRead(AcceptWait); | ||||
| 
 | ||||
|     for i := 0 to LReadList.Count - 1 do | ||||
|     begin | ||||
|       // Doublecheck to see if we've been stopped | ||||
|       // Depending on timing - may not reach here | ||||
|       // if stopped the run method of the ancestor | ||||
| 
 | ||||
|       if not Stopped then | ||||
|       begin | ||||
|         IncomingData := FServer.Bindings.BindingByHandle(TIdStackSocketHandle(LReadList[i])); | ||||
|         ByteCount := IncomingData.RecvFrom(LBuffer, PeerIP, PeerPort, PeerIPVersion); | ||||
|         if ByteCount <= 0 then | ||||
|         begin | ||||
|           raise EIdUDPReceiveErrorZeroBytes.Create(RSIPMCastReceiveError0); | ||||
|         end; | ||||
|         SetLength(FBuffer, ByteCount); | ||||
|         CopyTIdBytes(LBuffer, 0, FBuffer, 0, ByteCount); | ||||
|         IncomingData.SetPeer(PeerIP, PeerPort, PeerIPVersion); | ||||
|         if FServer.ThreadedEvent then begin | ||||
|           IPMCastRead; | ||||
|         end else begin | ||||
|           Synchronize(IPMCastRead); | ||||
|         end; | ||||
|       end; | ||||
|     end; | ||||
|   finally | ||||
|     LReadList.Free; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastListenerThread.IPMCastRead; | ||||
| begin | ||||
|   FServer.PacketReceived(FBuffer, IncomingData); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										221
									
								
								indy/Core/IdIPMCastServer.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,221 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.7    14/06/2004 21:38:42  CCostelloe | ||||
|   Converted StringToTIn4Addr call | ||||
| 
 | ||||
|   Rev 1.6    09/06/2004 10:00:50  CCostelloe | ||||
|   Kylix 3 patch | ||||
| 
 | ||||
|   Rev 1.5    2004.02.03 5:43:52 PM  czhower | ||||
|   Name changes | ||||
| 
 | ||||
|   Rev 1.4    1/21/2004 3:11:10 PM  JPMugaas | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.3    10/26/2003 09:11:54 AM  JPMugaas | ||||
|   Should now work in NET. | ||||
| 
 | ||||
|   Rev 1.2    2003.10.24 10:38:28 AM  czhower | ||||
|   UDP Server todos | ||||
| 
 | ||||
|   Rev 1.1    2003.10.12 4:03:58 PM  czhower | ||||
|   compile todos | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:55:26 AM  JPMugaas | ||||
| 
 | ||||
|   2001-10-16  DSiders | ||||
|   Modified TIdIPMCastServer.MulticastBuffer to | ||||
|   validate the AHost argument to the method instead | ||||
|   of the MulticastGroup property. | ||||
| } | ||||
| 
 | ||||
| unit IdIPMCastServer; | ||||
| 
 | ||||
| { | ||||
|   Dr. Harley J. Mackenzie, Initial revision. | ||||
| } | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   IdComponent, | ||||
|   IdGlobal, | ||||
|   IdIPMCastBase, | ||||
|   IdSocketHandle; | ||||
| 
 | ||||
| const | ||||
|   DEF_IMP_LOOPBACK = True; | ||||
|   DEF_IMP_TTL = 1; | ||||
| 
 | ||||
| type | ||||
|   TIdIPMCastServer = class(TIdIPMCastBase) | ||||
|   protected | ||||
|     FBinding: TIdSocketHandle; | ||||
|     FBoundIP: String; | ||||
|     FBoundPort: TIdPort; | ||||
|     FLoopback: Boolean; | ||||
|     FTimeToLive: Byte; | ||||
|     // | ||||
|     procedure ApplyLoopback; | ||||
|     procedure ApplyTimeToLive; | ||||
|     procedure CloseBinding; override; | ||||
|     function GetActive: Boolean; override; | ||||
|     function GetBinding: TIdSocketHandle; override; | ||||
|     procedure Loaded; override; | ||||
|     procedure MulticastBuffer(const AHost: string; const APort: Integer; const ABuffer : TIdBytes); | ||||
|     procedure SetLoopback(const AValue: Boolean); virtual; | ||||
|     procedure SetTTL(const AValue: Byte); virtual; | ||||
|     procedure InitComponent; override; | ||||
|   public | ||||
|     procedure Send(const AData: string; AByteEncoding: IIdTextEncoding = nil | ||||
|       {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} | ||||
|       ); overload; | ||||
|     procedure Send(const ABuffer : TIdBytes); overload; | ||||
|     destructor Destroy; override; | ||||
|     // | ||||
|     property Binding: TIdSocketHandle read GetBinding; | ||||
|   published | ||||
|     property Active; | ||||
|     property BoundIP: String read FBoundIP write FBoundIP; | ||||
|     property BoundPort: TIdPort read FBoundPort write FBoundPort; | ||||
|     property Loopback: Boolean read FLoopback write SetLoopback default DEF_IMP_LOOPBACK; | ||||
|     property MulticastGroup; | ||||
|     property IPVersion; | ||||
|     property Port; | ||||
|     property ReuseSocket; | ||||
|     property TimeToLive: Byte read FTimeToLive write SetTTL default DEF_IMP_TTL; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| { TIdIPMCastServer } | ||||
| 
 | ||||
| uses | ||||
|   IdResourceStringsCore, | ||||
|   IdStack, | ||||
|   IdStackConsts, | ||||
|   SysUtils; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FLoopback := DEF_IMP_LOOPBACK; | ||||
|   FTimeToLive := DEF_IMP_TTL; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.Loaded; | ||||
| var | ||||
|   b: Boolean; | ||||
| begin | ||||
|   inherited Loaded; | ||||
|   b := FDsgnActive; | ||||
|   FDsgnActive := False; | ||||
|   Active := b; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdIPMCastServer.Destroy; | ||||
| begin | ||||
|   Active := False; | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.CloseBinding; | ||||
| begin | ||||
|   FreeAndNil(FBinding); | ||||
| end; | ||||
| 
 | ||||
| function TIdIPMCastServer.GetActive: Boolean; | ||||
| begin | ||||
|   Result := (inherited GetActive) or (Assigned(FBinding) and FBinding.HandleAllocated); | ||||
| end; | ||||
| 
 | ||||
| function TIdIPMCastServer.GetBinding: TIdSocketHandle; | ||||
| begin | ||||
|   if not Assigned(FBinding) then begin | ||||
|     FBinding := TIdSocketHandle.Create(nil); | ||||
|   end; | ||||
|   if not FBinding.HandleAllocated then begin | ||||
|     FBinding.IPVersion := FIPVersion; | ||||
|     FBinding.AllocateSocket(Id_SOCK_DGRAM); | ||||
|     FBinding.IP := FBoundIP; | ||||
|     FBinding.Port := FBoundPort; | ||||
|     FBinding.ReuseSocket := FReuseSocket; | ||||
|     FBinding.Bind; | ||||
|     ApplyTimeToLive; | ||||
|     ApplyLoopback; | ||||
|   end; | ||||
|   Result := FBinding; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.MulticastBuffer(const AHost: string; const APort: Integer; const ABuffer : TIdBytes); | ||||
| begin | ||||
|   // DS - if not IsValidMulticastGroup(FMulticastGroup) then | ||||
|   if not IsValidMulticastGroup(AHost) then begin | ||||
|     raise EIdMCastNotValidAddress.Create(RSIPMCastInvalidMulticastAddress); | ||||
|   end; | ||||
|   Binding.SendTo(AHost, APort, ABuffer, Binding.IPVersion); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.Send(const AData: string; AByteEncoding: IIdTextEncoding = nil | ||||
|   {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} | ||||
|   ); | ||||
| begin | ||||
|   MulticastBuffer(FMulticastGroup, FPort, ToBytes(AData, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF})); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.Send(const ABuffer : TIdBytes); | ||||
| begin | ||||
|   MulticastBuffer(FMulticastGroup, FPort, ABuffer); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.SetLoopback(const AValue: Boolean); | ||||
| begin | ||||
|   if FLoopback <> AValue then begin | ||||
|     FLoopback := AValue; | ||||
|     ApplyLoopback; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.SetTTL(const AValue: Byte); | ||||
| begin | ||||
|   if FTimeToLive <> AValue then begin | ||||
|     FTimeToLive := AValue; | ||||
|     ApplyTimeToLive; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.ApplyLoopback; | ||||
| begin | ||||
|   if Assigned(FBinding) and FBinding.HandleAllocated then begin | ||||
|     FBinding.SetLoopBack(FLoopback); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPMCastServer.ApplyTimeToLive; | ||||
| begin | ||||
|   if Assigned(FBinding) and FBinding.HandleAllocated then begin | ||||
|     FBinding.SetMulticastTTL(FTimeToLive); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
| 
 | ||||
							
								
								
									
										824
									
								
								indy/Core/IdIcmpClient.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,824 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.8    2004-04-25 12:08:24  Mattias | ||||
|   Fixed multithreading issue | ||||
| 
 | ||||
|   Rev 1.7    2004.02.03 4:16:42 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.6    2/1/2004 4:53:30 PM  JPMugaas | ||||
|   Removed Todo; | ||||
| 
 | ||||
|   Rev 1.5    2004.01.20 10:03:24 PM  czhower | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.4    2003.12.31 10:37:54 PM  czhower | ||||
|   GetTickcount --> Ticks | ||||
| 
 | ||||
|   Rev 1.3    10/16/2003 11:06:14 PM  SPerry | ||||
|   Moved ICMP_MIN to IdRawHeaders | ||||
| 
 | ||||
|   Rev 1.2    2003.10.11 5:48:04 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.1    2003.09.30 1:22:56 PM  czhower | ||||
|   Stack split for DotNet | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:44:30 AM  JPMugaas | ||||
| 
 | ||||
|   25/1/02: SGrobety: | ||||
|   Modified the component to support multithreaded PING and traceroute | ||||
|   NOTE!!! | ||||
|   The component no longer use the timing informations contained | ||||
|   in the packet to compute the roundtrip time. This is because | ||||
|   that information is only correctly set in case of ECHOREPLY | ||||
|   In case of TTL, it is incorrect. | ||||
| } | ||||
| 
 | ||||
| unit IdIcmpClient; | ||||
| 
 | ||||
| { | ||||
|   Note that we can NOT remove the DotNET IFDEFS from this unit.   The reason is | ||||
|   that Microsoft NET Framework 1.1 does not support ICMPv6 and that's required | ||||
|   for IPv6.  In Win32 and Linux, we definately can and want to support IPv6. | ||||
| 
 | ||||
|   If we support a later version of the NET framework that has a better API, I may | ||||
|   consider revisiting this. | ||||
| } | ||||
| 
 | ||||
| // SG 25/1/02: Modified the component to support multithreaded PING and traceroute | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdGlobal, | ||||
|   IdRawBase, | ||||
|   IdRawClient, | ||||
|   IdStackConsts, | ||||
|   IdBaseComponent; | ||||
| 
 | ||||
| const | ||||
|   DEF_PACKET_SIZE = 32; | ||||
|   MAX_PACKET_SIZE = 1024; | ||||
|   Id_TIDICMP_ReceiveTimeout = 5000; | ||||
| 
 | ||||
| type | ||||
|   TReplyStatusTypes = (rsEcho, | ||||
|     rsError, rsTimeOut, rsErrorUnreachable, | ||||
|     rsErrorTTLExceeded,rsErrorPacketTooBig, | ||||
|     rsErrorParameter, | ||||
|     rsErrorDatagramConversion, | ||||
|     rsErrorSecurityFailure, | ||||
|     rsSourceQuench, | ||||
|     rsRedirect, | ||||
|     rsTimeStamp, | ||||
|     rsInfoRequest, | ||||
|     rsAddressMaskRequest, | ||||
|     rsTraceRoute, | ||||
|     rsMobileHostReg, | ||||
|     rsMobileHostRedir, | ||||
|     rsIPv6WhereAreYou, | ||||
|     rsIPv6IAmHere, | ||||
|     rsSKIP); | ||||
| 
 | ||||
|   TReplyStatus = class(TObject) | ||||
|   protected | ||||
|     FBytesReceived: integer; // number of bytes in reply from host | ||||
|     FFromIpAddress: string;  // IP address of replying host | ||||
|     FToIpAddress : string;   //who receives it (i.e., us.  This is for multihorned machines | ||||
|     FMsgType: byte; | ||||
|     FMsgCode : Byte; | ||||
|     FSequenceId: word;       // sequence id of ping reply | ||||
|     // TODO: roundtrip time in ping reply should be float, not byte | ||||
|     FMsRoundTripTime: UInt32; // ping round trip time in milliseconds | ||||
|     FTimeToLive: byte;       // time to live | ||||
|     FReplyStatusType: TReplyStatusTypes; | ||||
|     FPacketNumber : Integer;//number in packet for TraceRoute | ||||
|     FHostName : String; //Hostname of computer that replied, used with TraceRoute | ||||
|     FMsg : String; | ||||
|     FRedirectTo : String; // valid only for rsRedirect | ||||
|   public | ||||
|     property RedirectTo : String read FRedirectTo write FRedirectTo; | ||||
|     property Msg : String read FMsg write FMsg; | ||||
|     property BytesReceived: integer read FBytesReceived write FBytesReceived; // number of bytes in reply from host | ||||
|     property FromIpAddress: string read FFromIpAddress write FFromIpAddress;  // IP address of replying host | ||||
|     property ToIpAddress : string read FToIpAddress write FToIpAddress;   //who receives it (i.e., us.  This is for multihorned machines | ||||
|     property MsgType: byte read FMsgType write FMsgType; | ||||
|     property MsgCode : Byte read FMsgCode write FMsgCode; | ||||
|     property SequenceId: word read FSequenceId write FSequenceId;       // sequence id of ping reply | ||||
|     // TODO: roundtrip time in ping reply should be float, not byte | ||||
|     property MsRoundTripTime: UInt32 read FMsRoundTripTime write FMsRoundTripTime; // ping round trip time in milliseconds | ||||
|     property TimeToLive: byte read FTimeToLive write FTimeToLive;       // time to live | ||||
|     property ReplyStatusType: TReplyStatusTypes read FReplyStatusType write FReplyStatusType; | ||||
|     property HostName : String read FHostName write FHostName; | ||||
|     property PacketNumber : Integer read FPacketNumber write FPacketNumber; | ||||
|   end; | ||||
| 
 | ||||
|   TOnReplyEvent = procedure(ASender: TComponent; const AReplyStatus: TReplyStatus) of object; | ||||
| 
 | ||||
|   // TODO: on MacOSX (and maybe iOS?), can use a UDP socket instead of a RAW | ||||
|   // socket so that non-privilege processes do not require root access... | ||||
| 
 | ||||
|   TIdCustomIcmpClient = class(TIdRawClient) | ||||
|   protected | ||||
|     FStartTime : TIdTicks; //this is a fallback if no packet is returned | ||||
|     FPacketSize : Integer; | ||||
|     FBufReceive: TIdBytes; | ||||
|     FBufIcmp: TIdBytes; | ||||
|     wSeqNo: word; | ||||
|     iDataSize: integer; | ||||
|     FReplyStatus: TReplyStatus; | ||||
|     FOnReply: TOnReplyEvent; | ||||
|     FReplydata: String; | ||||
|     // | ||||
|     {$IFNDEF DOTNET_1_1} | ||||
|     function DecodeIPv6Packet(BytesRead: UInt32): Boolean; | ||||
|     {$ENDIF} | ||||
|     function DecodeIPv4Packet(BytesRead: UInt32): Boolean; | ||||
|     function DecodeResponse(BytesRead: UInt32): Boolean; | ||||
|     procedure DoReply; virtual; | ||||
|     procedure GetEchoReply; | ||||
|     procedure InitComponent; override; | ||||
|     {$IFNDEF DOTNET_1_1} | ||||
|     procedure PrepareEchoRequestIPv6(const ABuffer: String); | ||||
|     {$ENDIF} | ||||
|     procedure PrepareEchoRequestIPv4(const ABuffer: String); | ||||
|     procedure PrepareEchoRequest(const ABuffer: String); | ||||
|     procedure SendEchoRequest; overload; | ||||
|     procedure SendEchoRequest(const AIP : String); overload; | ||||
|     function GetPacketSize: Integer; | ||||
|     procedure SetPacketSize(const AValue: Integer); | ||||
| 
 | ||||
|     //these are made public in the client | ||||
|     procedure InternalPing(const AIP : String; const ABuffer: String = ''; SequenceID: Word = 0); overload; {Do not Localize} | ||||
|     // | ||||
|     property PacketSize : Integer read GetPacketSize write SetPacketSize default DEF_PACKET_SIZE; | ||||
|     property ReplyData: string read FReplydata; | ||||
|     property ReplyStatus: TReplyStatus read FReplyStatus; | ||||
| 
 | ||||
|     property OnReply: TOnReplyEvent read FOnReply write FOnReply; | ||||
| 
 | ||||
|   public | ||||
|     destructor Destroy; override; | ||||
|     procedure Send(const AHost: string; const APort: TIdPort; const ABuffer : TIdBytes); override; | ||||
|     procedure Send(const ABuffer : TIdBytes); override; | ||||
|     function Receive(ATimeOut: Integer): TReplyStatus; | ||||
|   end; | ||||
| 
 | ||||
|   TIdIcmpClient = class(TIdCustomIcmpClient) | ||||
|   public | ||||
|     procedure Ping(const ABuffer: String = ''; SequenceID: Word = 0);    {Do not Localize} | ||||
|     property ReplyData; | ||||
|     property ReplyStatus; | ||||
|   published | ||||
|     property Host; | ||||
|     {$IFNDEF DOTNET_1_1} | ||||
|     property IPVersion; | ||||
|     {$ENDIF} | ||||
|     property PacketSize; | ||||
|     property ReceiveTimeout default Id_TIDICMP_ReceiveTimeout; | ||||
|     property OnReply; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   //facilitate inlining only. | ||||
|   {$IFDEF WINDOWS} | ||||
|   Windows, | ||||
|   {$ENDIF} | ||||
|   {$IFDEF USE_VCL_POSIX} | ||||
|     {$IFDEF DARWIN} | ||||
|   Macapi.CoreServices, | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   IdExceptionCore, IdRawHeaders, IdResourceStringsCore, | ||||
|   IdStack, IdStruct, SysUtils; | ||||
| 
 | ||||
| { TIdCustomIcmpClient } | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.PrepareEchoRequest(const ABuffer: String); | ||||
| begin | ||||
|   {$IFNDEF DOTNET_1_1} | ||||
|   if IPVersion = Id_IPv6 then begin | ||||
|     PrepareEchoRequestIPv6(ABuffer); | ||||
|     Exit; | ||||
|   end; | ||||
|   {$ENDIF} | ||||
|   PrepareEchoRequestIPv4(ABuffer); | ||||
| end; | ||||
| 
 | ||||
| { TIdIPv4_ICMP } | ||||
| 
 | ||||
| type | ||||
|   TIdIPv4_ICMP = class(TIdStruct) | ||||
|   protected | ||||
|     Fip_hdr: TIdIPHdr; | ||||
|     Ficmp_hdr: TIdICMPHdr; | ||||
|     function GetBytesLen: UInt32; override; | ||||
|   public | ||||
|     constructor Create; override; | ||||
|     destructor Destroy; override; | ||||
|     procedure ReadStruct(const ABytes : TIdBytes; var VIndex : UInt32); override; | ||||
|     procedure WriteStruct(var VBytes : TIdBytes; var VIndex : UInt32); override; | ||||
|     property ip_hdr: TIdIPHdr read Fip_hdr; | ||||
|     property icmp_hdr: TIdICMPHdr read Ficmp_hdr; | ||||
|   end; | ||||
| 
 | ||||
| constructor TIdIPv4_ICMP.Create; | ||||
| begin | ||||
|   inherited Create; | ||||
|   Fip_hdr := TIdIPHdr.Create; | ||||
|   Ficmp_hdr := TIdICMPHdr.Create; | ||||
| end; | ||||
|    | ||||
| destructor TIdIPv4_ICMP.Destroy; | ||||
| begin | ||||
|   FreeAndNil(Fip_hdr); | ||||
|   FreeAndNil(Ficmp_hdr); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| function TIdIPv4_ICMP.GetBytesLen: UInt32; | ||||
| begin | ||||
|   Result := inherited GetBytesLen + Fip_hdr.BytesLen + Ficmp_hdr.BytesLen; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPv4_ICMP.ReadStruct(const ABytes : TIdBytes; var VIndex : UInt32); | ||||
| begin | ||||
|   inherited ReadStruct(ABytes, VIndex); | ||||
|   Fip_hdr.ReadStruct(ABytes, VIndex); | ||||
|   Ficmp_hdr.ReadStruct(ABytes, VIndex); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIPv4_ICMP.WriteStruct(var VBytes : TIdBytes; var VIndex : UInt32); | ||||
| begin | ||||
|   inherited WriteStruct(VBytes, VIndex); | ||||
|   Fip_hdr.WriteStruct(VBytes, VIndex); | ||||
|   Ficmp_hdr.WriteStruct(VBytes, VIndex); | ||||
| end; | ||||
| 
 | ||||
| { TIdCustomIcmpClient } | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.SendEchoRequest; | ||||
| begin | ||||
|   Send(FBufIcmp); | ||||
| end; | ||||
| 
 | ||||
| function TIdCustomIcmpClient.DecodeResponse(BytesRead: UInt32): Boolean; | ||||
| begin | ||||
|   if BytesRead = 0 then begin | ||||
|     // Timed out | ||||
|     FReplyStatus.MsRoundTripTime := GetElapsedTicks(FStartTime); | ||||
|     FReplyStatus.BytesReceived   := 0; | ||||
|     if IPVersion = Id_IPv4 then | ||||
|     begin | ||||
|       FReplyStatus.FromIpAddress   := '0.0.0.0'; | ||||
|       FReplyStatus.ToIpAddress     := '0.0.0.0'; | ||||
|     end else | ||||
|     begin | ||||
|       FReplyStatus.FromIpAddress   := '::0'; | ||||
|       FReplyStatus.ToIpAddress     := '::0'; | ||||
|     end; | ||||
|     FReplyStatus.MsgType         := 0; | ||||
|     FReplyStatus.SequenceId      := wSeqNo; | ||||
|     FReplyStatus.TimeToLive      := 0; | ||||
|     FReplyStatus.ReplyStatusType := rsTimeOut; | ||||
|     Result := True; | ||||
|   end else | ||||
|   begin | ||||
|     FReplyStatus.ReplyStatusType := rsError; | ||||
|     {$IFNDEF DOTNET_1_1} | ||||
|     if IPVersion = Id_IPv6 then begin | ||||
|       Result := DecodeIPv6Packet(BytesRead); | ||||
|       Exit; | ||||
|     end; | ||||
|     {$ENDIF} | ||||
|     Result := DecodeIPv4Packet(BytesRead); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.GetEchoReply; | ||||
| begin | ||||
|   Receive(FReceiveTimeout); | ||||
| end; | ||||
| 
 | ||||
| function TIdCustomIcmpClient.Receive(ATimeOut: Integer): TReplyStatus; | ||||
| var | ||||
|   BytesRead : Integer; | ||||
|   TripTime: UInt32; | ||||
| begin | ||||
|   Result := FReplyStatus; | ||||
|   FillBytes(FBufReceive, Length(FBufReceive), 0); | ||||
|   FStartTime := Ticks64; | ||||
|   repeat | ||||
|     BytesRead := ReceiveBuffer(FBufReceive, ATimeOut); | ||||
|     if DecodeResponse(BytesRead) then begin | ||||
|       Break; | ||||
|     end; | ||||
|     TripTime := GetElapsedTicks(FStartTime); | ||||
|     ATimeOut := ATimeOut - Integer(TripTime); // compute new timeout value | ||||
|     FReplyStatus.MsRoundTripTime := TripTime; | ||||
|     FReplyStatus.Msg := RSICMPTimeout; | ||||
|     // We caught a response that wasn't meant for this thread - so we must | ||||
|     // make sure we don't report it as such in case we time out after this | ||||
|     FReplyStatus.BytesReceived   := 0; | ||||
|     if IPVersion = Id_IPv4 then | ||||
|     begin | ||||
|       FReplyStatus.FromIpAddress   := '0.0.0.0'; | ||||
|       FReplyStatus.ToIpAddress     := '0.0.0.0'; | ||||
|     end else | ||||
|     begin | ||||
|       FReplyStatus.FromIpAddress   := '::0'; | ||||
|       FReplyStatus.ToIpAddress     := '::0'; | ||||
|     end; | ||||
|     FReplyStatus.MsgType         := 0; | ||||
|     FReplyStatus.SequenceId      := wSeqNo; | ||||
|     FReplyStatus.TimeToLive      := 0; | ||||
|     FReplyStatus.ReplyStatusType := rsTimeOut; | ||||
|   until ATimeOut <= 0; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.DoReply; | ||||
| begin | ||||
|   if Assigned(FOnReply) then begin | ||||
|     FOnReply(Self, FReplyStatus); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FReplyStatus:= TReplyStatus.Create; | ||||
|   FProtocol := Id_IPPROTO_ICMP; | ||||
|   {$IFNDEF DOTNET_1_1} | ||||
|   ProtocolIPv6 := Id_IPPROTO_ICMPv6; | ||||
|   {$ENDIF} | ||||
|   wSeqNo := 3489; // SG 25/1/02: Arbitrary Constant <> 0 | ||||
|   FReceiveTimeOut := Id_TIDICMP_ReceiveTimeout; | ||||
|   FPacketSize := DEF_PACKET_SIZE; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdCustomIcmpClient.Destroy; | ||||
| begin | ||||
|   FreeAndNil(FReplyStatus); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| function TIdCustomIcmpClient.DecodeIPv4Packet(BytesRead: UInt32): Boolean; | ||||
| var | ||||
|   LIPHeaderLen: UInt32; | ||||
|   LIdx: UInt32; | ||||
|   RTTime: UInt32; | ||||
|   LActualSeqID: UInt16; | ||||
|   LIcmp: TIdIPv4_ICMP; | ||||
|   LIcmpts: TIdICMPTs; | ||||
| begin | ||||
|   Result := False; | ||||
| 
 | ||||
|   LIpHeaderLen := (FBufReceive[0] and $0F) * 4; | ||||
|   if BytesRead < (LIpHeaderLen + ICMP_MIN) then begin | ||||
|     raise EIdIcmpException.Create(RSICMPNotEnoughtBytes); | ||||
|   end; | ||||
|   LIdx := 0; | ||||
| 
 | ||||
|   LIcmp := TIdIPv4_ICMP.Create; | ||||
|   try | ||||
|     LIcmp.ReadStruct(FBufReceive, LIdx); | ||||
| 
 | ||||
|     {$IFDEF LINUX} | ||||
|     // TODO: baffled as to why linux kernel sends back echo from localhost | ||||
|     {$ENDIF} | ||||
| 
 | ||||
|     case LIcmp.icmp_hdr.icmp_type of | ||||
|       Id_ICMP_ECHOREPLY, Id_ICMP_ECHO: | ||||
|       begin | ||||
|         FReplyStatus.ReplyStatusType := rsEcho; | ||||
|         FReplyData := BytesToStringRaw(FBufReceive, LIdx, -1); | ||||
|         // result is only valid if the seq. number is correct | ||||
|       end; | ||||
|       Id_ICMP_UNREACH: | ||||
|         FReplyStatus.ReplyStatusType := rsErrorUnreachable; | ||||
|       Id_ICMP_TIMXCEED: | ||||
|         FReplyStatus.ReplyStatusType := rsErrorTTLExceeded; | ||||
|       Id_ICMP_PARAMPROB : | ||||
|         FReplyStatus.ReplyStatusType := rsErrorParameter; | ||||
|       Id_ICMP_REDIRECT : | ||||
|         FReplyStatus.ReplyStatusType := rsRedirect; | ||||
|       Id_ICMP_TSTAMP, Id_ICMP_TSTAMPREPLY : | ||||
|         FReplyStatus.ReplyStatusType := rsTimeStamp; | ||||
|       Id_ICMP_IREQ, Id_ICMP_IREQREPLY : | ||||
|         FReplyStatus.ReplyStatusType := rsInfoRequest; | ||||
|       Id_ICMP_MASKREQ, Id_ICMP_MASKREPLY : | ||||
|         FReplyStatus.ReplyStatusType := rsAddressMaskRequest; | ||||
|       Id_ICMP_TRACEROUTE : | ||||
|         FReplyStatus.ReplyStatusType := rsTraceRoute; | ||||
|       Id_ICMP_DATAGRAM_CONV : | ||||
|         FReplyStatus.ReplyStatusType := rsErrorDatagramConversion; | ||||
|       Id_ICMP_MOB_HOST_REDIR : | ||||
|         FReplyStatus.ReplyStatusType := rsMobileHostRedir; | ||||
|       Id_ICMP_IPv6_WHERE_ARE_YOU : | ||||
|         FReplyStatus.ReplyStatusType := rsIPv6WhereAreYou; | ||||
|       Id_ICMP_IPv6_I_AM_HERE : | ||||
|         FReplyStatus.ReplyStatusType := rsIPv6IAmHere; | ||||
|       Id_ICMP_MOB_REG_REQ, Id_ICMP_MOB_REG_REPLY : | ||||
|         FReplyStatus.ReplyStatusType := rsMobileHostReg; | ||||
|       Id_ICMP_PHOTURIS : | ||||
|         FReplyStatus.ReplyStatusType := rsErrorSecurityFailure; | ||||
|       else | ||||
|         raise EIdICMPException.Create(RSICMPNonEchoResponse);// RSICMPNonEchoResponse = 'Non-echo type response received' | ||||
|     end;    // case | ||||
| 
 | ||||
|     // check if we got a reply to the packet that was actually sent | ||||
|     case FReplyStatus.ReplyStatusType of | ||||
|       rsEcho: | ||||
|       begin | ||||
|         LActualSeqID := LIcmp.icmp_hdr.icmp_hun.echo_seq; | ||||
|         RTTime := GetElapsedTicks(BytesToTicks(FBufReceive, LIdx)); | ||||
|       end; | ||||
|       rsTimeStamp: | ||||
|       begin | ||||
|         LActualSeqID := LIcmp.icmp_hdr.icmp_hun.echo_seq; | ||||
|         LIcmpts := TIdICMPTs.Create; | ||||
|         try | ||||
|           LIcmpts.ReadStruct(FBufReceive, LIpHeaderLen); | ||||
|           RTTime := (LIcmpts.ttime and $80000000) - (LIcmpts.otime and $80000000); | ||||
|         finally | ||||
|           LIcmpts.Free; | ||||
|         end; | ||||
|       end; | ||||
|     else | ||||
|       begin | ||||
|         // not an echo or timestamp reply: the original IP frame is | ||||
|         // contained withing the DATA section of the packet... | ||||
|         // pOriginalIP := PIdIPHdr(@picmp^.icmp_dun.data); | ||||
| 
 | ||||
|         // TODO: verify this!  I don't think it is indexing far enough into the data | ||||
|         LActualSeqID := BytesToUInt16(FBufReceive, LIpHeaderLen+8+6);//pOriginalICMP^.icmp_hun.echo.seq; | ||||
|         RTTime := GetElapsedTicks(BytesToTicks(FBufReceive, LIpHeaderLen+8+8)); //pOriginalICMP^.icmp_dun.ts.otime; | ||||
| 
 | ||||
|         // move to offset | ||||
|         // pOriginalICMP := Pointer(PtrUInt(pOriginalIP) + (iIpHeaderLen)); | ||||
|         // extract information from original ICMP frame | ||||
|         // ActualSeqID := pOriginalICMP^.icmp_hun.echo.seq; | ||||
|         // RTTime := Ticks64 - pOriginalICMP^.icmp_dun.ts.otime; | ||||
|         // Result := pOriginalICMP^.icmp_hun.echo.seq = wSeqNo; | ||||
|       end; | ||||
|     end; | ||||
| 
 | ||||
|     Result := LActualSeqID = wSeqNo;//;picmp^.icmp_hun.echo.seq  = wSeqNo; | ||||
|     if Result then | ||||
|     begin | ||||
|       if FReplyStatus.ReplyStatusType = rsEcho then begin | ||||
|         FReplyStatus.BytesReceived := BytesRead - (Id_IP_HSIZE + ICMP_MIN + SizeOf(UInt32)); | ||||
|       end else begin | ||||
|         FReplyStatus.BytesReceived := BytesRead - (Id_IP_HSIZE + ICMP_MIN); | ||||
|       end; | ||||
| 
 | ||||
|       FReplyStatus.FromIpAddress := MakeUInt32IntoIPv4Address(GStack.NetworkToHost(Licmp.ip_hdr.ip_src.s_l)); | ||||
|       FReplyStatus.ToIpAddress   := MakeUInt32IntoIPv4Address(GStack.NetworkToHost(Licmp.ip_hdr.ip_dst.s_l)); | ||||
|       FReplyStatus.MsgType := LIcmp.icmp_hdr.icmp_type; //picmp^.icmp_type; | ||||
|       FReplyStatus.MsgCode := LIcmp.icmp_hdr.icmp_code; //picmp^.icmp_code; | ||||
|       FReplyStatus.SequenceId := LActualSeqID; | ||||
|       FReplyStatus.MsRoundTripTime := RTTime; | ||||
|       FReplyStatus.TimeToLive := LIcmp.ip_hdr.ip_ttl; | ||||
|       // now process our message stuff | ||||
| 
 | ||||
|       case FReplyStatus.MsgType of | ||||
|         Id_ICMP_UNREACH: | ||||
|         begin | ||||
|           case FReplyStatus.MsgCode of | ||||
|             Id_ICMP_UNREACH_NET                : FReplyStatus.Msg := RSICMPNetUnreachable; | ||||
|             Id_ICMP_UNREACH_HOST               : FReplyStatus.Msg := RSICMPHostUnreachable; | ||||
|             Id_ICMP_UNREACH_PROTOCOL           : FReplyStatus.Msg := RSICMPProtUnreachable; | ||||
|             Id_ICMP_UNREACH_NEEDFRAG           : FReplyStatus.Msg := RSICMPFragmentNeeded; | ||||
|             Id_ICMP_UNREACH_SRCFAIL            : FReplyStatus.Msg := RSICMPSourceRouteFailed; | ||||
|             Id_ICMP_UNREACH_NET_UNKNOWN        : FReplyStatus.Msg := RSICMPDestNetUnknown; | ||||
|             Id_ICMP_UNREACH_HOST_UNKNOWN       : FReplyStatus.Msg := RSICMPDestHostUnknown; | ||||
|             Id_ICMP_UNREACH_ISOLATED           : FReplyStatus.Msg := RSICMPSourceIsolated; | ||||
|             Id_ICMP_UNREACH_NET_PROHIB         : FReplyStatus.Msg := RSICMPDestNetProhibitted; | ||||
|             Id_ICMP_UNREACH_HOST_PROHIB        : FReplyStatus.Msg := RSICMPDestHostProhibitted; | ||||
|             Id_ICMP_UNREACH_TOSNET             : FReplyStatus.Msg := RSICMPTOSNetUnreach; | ||||
|             Id_ICMP_UNREACH_TOSHOST            : FReplyStatus.Msg := RSICMPTOSHostUnreach; | ||||
|             Id_ICMP_UNREACH_FILTER_PROHIB      : FReplyStatus.Msg := RSICMPAdminProhibitted; | ||||
|             Id_ICMP_UNREACH_HOST_PRECEDENCE    : FReplyStatus.Msg := RSICMPHostPrecViolation; | ||||
|             Id_ICMP_UNREACH_PRECEDENCE_CUTOFF  : FReplyStatus.Msg := RSICMPPrecedenceCutoffInEffect; | ||||
|           end; | ||||
|         end; | ||||
|         Id_ICMP_TIMXCEED: | ||||
|         begin | ||||
|           case FReplyStatus.MsgCode of | ||||
|             0 : FReplyStatus.Msg := RSICMPTTLExceeded; | ||||
|             1 : FReplyStatus.Msg := RSICMPFragAsmExceeded; | ||||
|           end; | ||||
|         end; | ||||
|         Id_ICMP_PARAMPROB                   : FReplyStatus.Msg := IndyFormat(RSICMPParamError, [FReplyStatus.MsgCode]); | ||||
|         Id_ICMP_REDIRECT: | ||||
|         begin | ||||
|           FReplyStatus.RedirectTo := MakeUInt32IntoIPv4Address(GStack.NetworkToHOst(LIcmp.icmp_hdr.icmp_hun.gateway_s_l)); | ||||
|           case FReplyStatus.MsgCode of | ||||
|             0 : FReplyStatus.Msg := RSICMPRedirNet; | ||||
|             1 : FReplyStatus.Msg := RSICMPRedirHost; | ||||
|             2 : FReplyStatus.Msg := RSICMPRedirTOSNet; | ||||
|             3 : FReplyStatus.Msg := RSICMPRedirTOSHost; | ||||
|           end; | ||||
|         end; | ||||
|         Id_ICMP_SOURCEQUENCH                : FReplyStatus.Msg := RSICMPSourceQuenchMsg; | ||||
|         Id_ICMP_ECHOREPLY, Id_ICMP_ECHO     : FReplyStatus.Msg := RSICMPEcho; | ||||
|         Id_ICMP_TSTAMP, Id_ICMP_TSTAMPREPLY : FReplyStatus.Msg := RSICMPTimeStamp; | ||||
|         Id_ICMP_IREQ, Id_ICMP_IREQREPLY     : FReplyStatus.Msg := RSICMPTimeStamp; | ||||
|         Id_ICMP_MASKREQ, Id_ICMP_MASKREPLY  : FReplyStatus.Msg := RSICMPMaskRequest; | ||||
|         Id_ICMP_TRACEROUTE : | ||||
|         begin | ||||
|           case FReplyStatus.MsgCode of | ||||
|             Id_ICMP_TRACEROUTE_PACKET_FORWARDED : FReplyStatus.Msg := RSICMPTracePacketForwarded; | ||||
|             Id_ICMP_TRACEROUTE_NO_ROUTE         : FReplyStatus.Msg := RSICMPTraceNoRoute; | ||||
|           end; | ||||
|         end; | ||||
|         Id_ICMP_DATAGRAM_CONV: | ||||
|         begin | ||||
|           case FReplyStatus.MsgCode of | ||||
|             Id_ICMP_CONV_UNSPEC                    : FReplyStatus.Msg := RSICMPTracePacketForwarded; | ||||
|             Id_ICMP_CONV_DONTCONV_OPTION           : FReplyStatus.Msg := RSICMPTraceNoRoute; | ||||
|             Id_ICMP_CONV_UNKNOWN_MAN_OPTION        : FReplyStatus.Msg := RSICMPConvUnknownMandOptPresent; | ||||
|             Id_ICMP_CONV_UNKNWON_UNSEP_OPTION      : FReplyStatus.Msg := RSICMPConvKnownUnsupportedOptionPresent; | ||||
|             Id_ICMP_CONV_UNSEP_TRANSPORT           : FReplyStatus.Msg := RSICMPConvUnsupportedTransportProtocol; | ||||
|             Id_ICMP_CONV_OVERALL_LENGTH_EXCEEDED   : FReplyStatus.Msg := RSICMPConvOverallLengthExceeded; | ||||
|             Id_ICMP_CONV_IP_HEADER_LEN_EXCEEDED    : FReplyStatus.Msg := RSICMPConvIPHeaderLengthExceeded; | ||||
|             Id_ICMP_CONV_TRANS_PROT_255            : FReplyStatus.Msg := RSICMPConvTransportProtocol_255; | ||||
|             Id_ICMP_CONV_PORT_OUT_OF_RANGE         : FReplyStatus.Msg := RSICMPConvPortConversionOutOfRange; | ||||
|             Id_ICMP_CONV_TRANS_HEADER_LEN_EXCEEDED : FReplyStatus.Msg := RSICMPConvTransportHeaderLengthExceeded; | ||||
|             Id_ICMP_CONV_32BIT_ROLLOVER_AND_ACK    : FReplyStatus.Msg := RSICMPConv32BitRolloverMissingAndACKSet; | ||||
|             Id_ICMP_CONV_UNKNOWN_MAN_TRANS_OPTION  : FReplyStatus.Msg := RSICMPConvUnknownMandatoryTransportOptionPresent; | ||||
|           end; | ||||
|         end; | ||||
|         Id_ICMP_MOB_HOST_REDIR                     : FReplyStatus.Msg := RSICMPMobileHostRedirect; | ||||
|         Id_ICMP_IPv6_WHERE_ARE_YOU                 : FReplyStatus.Msg := RSICMPIPv6WhereAreYou; | ||||
|         Id_ICMP_IPv6_I_AM_HERE                     : FReplyStatus.Msg := RSICMPIPv6IAmHere; | ||||
|         Id_ICMP_MOB_REG_REQ, Id_ICMP_MOB_REG_REPLY : FReplyStatus.Msg := RSICMPIPv6IAmHere; | ||||
|         Id_ICMP_SKIP                               : FReplyStatus.Msg := RSICMPSKIP; | ||||
|         Id_ICMP_PHOTURIS : | ||||
|         begin | ||||
|           case FReplyStatus.MsgCode of | ||||
|             Id_ICMP_BAD_SPI             : FReplyStatus.Msg := RSICMPSecBadSPI; | ||||
|             Id_ICMP_AUTH_FAILED         : FReplyStatus.Msg := RSICMPSecAuthenticationFailed; | ||||
|             Id_ICMP_DECOMPRESS_FAILED   : FReplyStatus.Msg := RSICMPSecDecompressionFailed; | ||||
|             Id_ICMP_DECRYPTION_FAILED   : FReplyStatus.Msg := RSICMPSecDecryptionFailed; | ||||
|             Id_ICMP_NEED_AUTHENTICATION : FReplyStatus.Msg := RSICMPSecNeedAuthentication; | ||||
|             Id_ICMP_NEED_AUTHORIZATION  : FReplyStatus.Msg := RSICMPSecNeedAuthorization; | ||||
|           end; | ||||
|         end; | ||||
|       end; | ||||
|     end; | ||||
|   finally | ||||
|     FreeAndNil(LIcmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.PrepareEchoRequestIPv4(const ABuffer: String); | ||||
| var | ||||
|   LIcmp: TIdICMPHdr; | ||||
|   LIdx: UInt32; | ||||
|   LBuffer: TIdBytes; | ||||
|   LBufferLen: Integer; | ||||
| begin | ||||
|   LBuffer := ToBytes(ABuffer, IndyTextEncoding_8Bit); | ||||
|   LBufferLen := IndyMin(Length(LBuffer), FPacketSize); | ||||
| 
 | ||||
|   SetLength(FBufIcmp, ICMP_MIN + SizeOf(TIdTicks) + LBufferLen); | ||||
|   FillBytes(FBufIcmp, Length(FBufIcmp), 0); | ||||
|   SetLength(FBufReceive, Length(FBufIcmp) + Id_IP_HSIZE); | ||||
| 
 | ||||
|   LIdx := 0; | ||||
|   LIcmp := TIdICMPHdr.Create; | ||||
|   try | ||||
|     LIcmp.icmp_type :=  Id_ICMP_ECHO; | ||||
|     LIcmp.icmp_code := 0; | ||||
|     LIcmp.icmp_sum := 0; | ||||
|     LIcmp.icmp_hun.echo_id := Word(CurrentProcessId); | ||||
|     LIcmp.icmp_hun.echo_seq := wSeqNo; | ||||
|     LIcmp.WriteStruct(FBufIcmp, LIdx); | ||||
|     CopyTIdTicks(Ticks64, FBufIcmp, LIdx); | ||||
|     Inc(LIdx, SizeOf(TIdTicks)); | ||||
|     if LBufferLen > 0 then begin | ||||
|       CopyTIdBytes(LBuffer, 0, FBufIcmp, LIdx, LBufferLen); | ||||
|     end; | ||||
|   finally | ||||
|     FreeAndNil(LIcmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| {$IFNDEF DOTNET_1_1} | ||||
| procedure TIdCustomIcmpClient.PrepareEchoRequestIPv6(const ABuffer: String); | ||||
| var | ||||
|   LIcmp : TIdicmp6_hdr; | ||||
|   LIdx : UInt32; | ||||
|   LBuffer: TIdBytes; | ||||
|   LBufferLen: Integer; | ||||
| begin | ||||
|   LBuffer := ToBytes(ABuffer, IndyTextEncoding_8Bit); | ||||
|   LBufferLen := IndyMin(Length(LBuffer), FPacketSize); | ||||
| 
 | ||||
|   SetLength(FBufIcmp, ICMP_MIN + SizeOf(TIdTicks) + LBufferLen); | ||||
|   FillBytes(FBufIcmp, Length(FBufIcmp), 0); | ||||
|   SetLength(FBufReceive, Length(FBufIcmp) + (Id_IPv6_HSIZE*2)); | ||||
| 
 | ||||
|   LIdx := 0; | ||||
|   LIcmp := TIdicmp6_hdr.Create; | ||||
|   try | ||||
|     LIcmp.icmp6_type := ICMP6_ECHO_REQUEST; | ||||
|     LIcmp.icmp6_code := 0; | ||||
|     LIcmp.data.icmp6_un_data16[0] := Word(CurrentProcessId); | ||||
|     LIcmp.data.icmp6_un_data16[1] := wSeqNo; | ||||
|     LIcmp.icmp6_cksum := 0; | ||||
|     LIcmp.WriteStruct(FBufIcmp, LIdx); | ||||
|     CopyTIdTicks(Ticks64, FBufIcmp, LIdx); | ||||
|     Inc(LIdx, SizeOf(TIdTicks)); | ||||
|     if LBufferLen > 0 then begin | ||||
|       CopyTIdBytes(LBuffer, 0, FBufIcmp, LIdx, LBufferLen); | ||||
|     end; | ||||
|   finally | ||||
|     FreeAndNil(LIcmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdCustomIcmpClient.DecodeIPv6Packet(BytesRead: UInt32): Boolean; | ||||
| var | ||||
|   LIdx : UInt32; | ||||
|   LIcmp : TIdicmp6_hdr; | ||||
|   RTTime : UInt32; | ||||
|   LActualSeqID : Word; | ||||
| begin | ||||
|   LIdx := 0; | ||||
|   LIcmp := TIdicmp6_hdr.Create; | ||||
|   try | ||||
|     // Note that IPv6 raw headers are not being returned. | ||||
|     LIcmp.ReadStruct(FBufReceive, LIdx); | ||||
| 
 | ||||
|     case LIcmp.icmp6_type of | ||||
|       ICMP6_ECHO_REQUEST, | ||||
|       ICMP6_ECHO_REPLY           : FReplyStatus.ReplyStatusType := rsEcho; | ||||
|       //group membership messages | ||||
|       ICMP6_MEMBERSHIP_QUERY     : ; | ||||
|       ICMP6_MEMBERSHIP_REPORT    : ; | ||||
|       ICMP6_MEMBERSHIP_REDUCTION : ; | ||||
|       //errors | ||||
|       ICMP6_DST_UNREACH          : FReplyStatus.ReplyStatusType := rsErrorUnreachable; | ||||
|       ICMP6_PACKET_TOO_BIG       : FReplyStatus.ReplyStatusType := rsErrorPacketTooBig; | ||||
|       ICMP6_TIME_EXCEEDED        : FReplyStatus.ReplyStatusType := rsErrorTTLExceeded; | ||||
|       ICMP6_PARAM_PROB           : FReplyStatus.ReplyStatusType := rsErrorParameter; | ||||
|       else                         FReplyStatus.ReplyStatusType  := rsError; | ||||
|     end; | ||||
|     FReplyStatus.MsgType := LIcmp.icmp6_type; //picmp^.icmp_type; | ||||
|     FReplyStatus.MsgCode := LIcmp.icmp6_code; | ||||
| 
 | ||||
|     //errors are values less than ICMP6_INFOMSG_MASK | ||||
|     if LIcmp.icmp6_type < ICMP6_INFOMSG_MASK then | ||||
|     begin | ||||
|       //read info from the original packet part | ||||
|       LIcmp.ReadStruct(FBufReceive, LIdx); | ||||
|     end; | ||||
| 
 | ||||
|     LActualSeqID := LIcmp.data.icmp6_seq; | ||||
|     Result := LActualSeqID = wSeqNo; | ||||
| 
 | ||||
|     RTTime := GetElapsedTicks(BytesToTicks(FBufReceive, LIdx)); | ||||
|     Inc(LIdx, SizeOf(TIdTicks)); | ||||
| 
 | ||||
|     if Result then | ||||
|     begin | ||||
|       FReplyStatus.BytesReceived := BytesRead - LIdx; | ||||
|       FReplyStatus.SequenceId := LActualSeqID; | ||||
|       FReplyStatus.MsRoundTripTime := RTTime; | ||||
|       // TimeToLive := FBufReceive[8]; | ||||
|       // TimeToLive := pip^.ip_ttl; | ||||
|       FReplyStatus.TimeToLive := FPkt.TTL; | ||||
|       FReplyStatus.FromIpAddress := FPkt.SourceIP; | ||||
|       FReplyStatus.ToIpAddress := FPkt.DestIP; | ||||
| 
 | ||||
|       case FReplyStatus.MsgType of | ||||
|         ICMP6_ECHO_REQUEST, ICMP6_ECHO_REPLY : FReplyStatus.Msg := RSICMPEcho; | ||||
|         ICMP6_TIME_EXCEEDED : | ||||
|         begin | ||||
|           case FReplyStatus.MsgCode of | ||||
|             ICMP6_TIME_EXCEED_TRANSIT    : FReplyStatus.Msg := RSICMPHopLimitExceeded; | ||||
|             ICMP6_TIME_EXCEED_REASSEMBLY : FReplyStatus.Msg := RSICMPFragAsmExceeded; | ||||
|           end; | ||||
|         end; | ||||
|         ICMP6_DST_UNREACH : | ||||
|         begin | ||||
|           case FReplyStatus.MsgCode of | ||||
|             ICMP6_DST_UNREACH_NOROUTE          : FReplyStatus.Msg := RSICMPNoRouteToDest; | ||||
|             ICMP6_DST_UNREACH_ADMIN            : FReplyStatus.Msg := RSICMPAdminProhibitted; | ||||
|             ICMP6_DST_UNREACH_ADDR             : FReplyStatus.Msg := RSICMPHostUnreachable; | ||||
|             ICMP6_DST_UNREACH_NOPORT           : FReplyStatus.Msg := RSICMPProtUnreachable; | ||||
|             ICMP6_DST_UNREACH_SOURCE_FILTERING : FReplyStatus.Msg := RSICMPSourceFilterFailed; | ||||
|             ICMP6_DST_UNREACH_REJCT_DST        : FReplyStatus.Msg := RSICMPRejectRoutToDest; | ||||
|           end; | ||||
|         end; | ||||
|         ICMP6_PACKET_TOO_BIG           : FReplyStatus.Msg := IndyFormat(RSICMPPacketTooBig, [LIcmp.data.icmp6_mtu]); | ||||
|         ICMP6_PARAM_PROB : | ||||
|         begin | ||||
|           case FReplyStatus.MsgCode of | ||||
|             ICMP6_PARAMPROB_HEADER     : FReplyStatus.Msg := IndyFormat(RSICMPParamHeader, [LIcmp.data.icmp6_pptr]); | ||||
|             ICMP6_PARAMPROB_NEXTHEADER : FReplyStatus.Msg := IndyFormat(RSICMPParamNextHeader, [LIcmp.data.icmp6_pptr]); | ||||
|             ICMP6_PARAMPROB_OPTION     : FReplyStatus.Msg := IndyFormat(RSICMPUnrecognizedOpt, [LIcmp.data.icmp6_pptr]); | ||||
|           end; | ||||
|         end; | ||||
|         ICMP6_MEMBERSHIP_QUERY : ; | ||||
|         ICMP6_MEMBERSHIP_REPORT : ; | ||||
|         ICMP6_MEMBERSHIP_REDUCTION :; | ||||
|       end; | ||||
|     end; | ||||
|   finally | ||||
|     FreeAndNil(LIcmp); | ||||
|   end; | ||||
| end; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.Send(const AHost: string; const APort: TIdPort; | ||||
|   const ABuffer: TIdBytes); | ||||
| var | ||||
|   LBuffer : TIdBytes; | ||||
|   LIP : String; | ||||
| begin | ||||
|   LBuffer := ABuffer; | ||||
|   LIP := GStack.ResolveHost(AHost, IPVersion); | ||||
|   GStack.WriteChecksum(Binding.Handle, LBuffer, 2, LIP, APort, IPVersion); | ||||
|   FBinding.SendTo(LIP, APort, LBuffer, IPVersion); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.Send(const ABuffer: TIdBytes); | ||||
| var | ||||
|   LBuffer : TIdBytes; | ||||
|   LIP : String; | ||||
| begin | ||||
|   LBuffer := ABuffer; | ||||
|   LIP := GStack.ResolveHost(Host, IPVersion); | ||||
|   GStack.WriteChecksum(Binding.Handle, LBuffer, 2, LIP, Port, IPVersion); | ||||
|   FBinding.SendTo(LIP, Port, LBuffer, IPVersion); | ||||
| end; | ||||
| 
 | ||||
| function TIdCustomIcmpClient.GetPacketSize: Integer; | ||||
| begin | ||||
|   Result := FPacketSize; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.SetPacketSize(const AValue: Integer); | ||||
| begin | ||||
|   if AValue < 0 then begin | ||||
|     FPacketSize := 0; | ||||
|   end else begin | ||||
|     FPacketSize := IndyMin(AValue, MAX_PACKET_SIZE); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.InternalPing(const AIP, ABuffer: String; SequenceID: Word); | ||||
| begin | ||||
|   if SequenceID <> 0 then begin | ||||
|     wSeqNo := SequenceID; | ||||
|   end; | ||||
|   PrepareEchoRequest(ABuffer); | ||||
|   SendEchoRequest(AIP); | ||||
|   GetEchoReply; | ||||
|   Binding.CloseSocket; | ||||
|   DoReply; | ||||
|   Inc(wSeqNo); // SG 25/1/02: Only increase sequence number when finished. | ||||
| end; | ||||
| 
 | ||||
| procedure TIdCustomIcmpClient.SendEchoRequest(const AIP: String); | ||||
| begin | ||||
|   Send(AIP, 0, FBufIcmp); | ||||
| end; | ||||
| 
 | ||||
| { TIdIcmpClient } | ||||
| 
 | ||||
| procedure TIdIcmpClient.Ping(const ABuffer: String; SequenceID: Word); | ||||
| begin | ||||
|   InternalPing(GStack.ResolveHost(Host, IPVersion), ABuffer, SequenceID); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										256
									
								
								indy/Core/IdIntercept.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,256 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.10    3/10/2005 12:00:46 AM  JPMugaas | ||||
|   Minor problem Craig Peterson had noted in an E-Mail to me. | ||||
| 
 | ||||
|   Rev 1.9    11/30/04 6:19:12 PM  RLebeau | ||||
|   Promoted the TIdConnectionIntercept.Intercept property from protected to | ||||
|   published | ||||
| 
 | ||||
|   Rev 1.8    2004.02.03 4:16:44 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.7    2004.01.20 10:03:24 PM  czhower | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.6    5/12/2003 12:33:32 AM  GGrieve | ||||
|   add Data from BlockCipher descendent | ||||
| 
 | ||||
|   Rev 1.5    2003.10.14 1:26:48 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.4    2003.10.11 5:48:16 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.3    10/5/2003 3:20:46 PM  BGooijen | ||||
|   .net | ||||
| 
 | ||||
|   Rev 1.2    2003.10.01 1:12:34 AM  czhower | ||||
|   .Net | ||||
| 
 | ||||
|   Rev 1.1    3/5/2003 10:59:48 PM  BGooijen | ||||
|   Fixed (i know, the SendBuffer looks bad) | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:44:42 AM  JPMugaas | ||||
| 
 | ||||
|   2002-03-01 - Andrew P.Rybin | ||||
|     - Nested Intercept support (ex: ->logging->compression->encryption) | ||||
| 
 | ||||
|   2002-04-09 - Chuck Smith | ||||
|     - set ABuffer.Position := 0; in OnSend/OnReceive for Nested Stream send/receive | ||||
| } | ||||
| 
 | ||||
| unit IdIntercept; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //here only to put FPC in Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdGlobal, IdBaseComponent, IdBuffer, IdException; | ||||
| 
 | ||||
| type | ||||
|   EIdInterceptCircularLink = class(EIdException); | ||||
|   TIdConnectionIntercept = class; | ||||
|   TIdInterceptNotifyEvent = procedure(ASender: TIdConnectionIntercept) of object; | ||||
|   TIdInterceptStreamEvent = procedure(ASender: TIdConnectionIntercept; var ABuffer: TIdBytes) of object; | ||||
| 
 | ||||
|   TIdConnectionIntercept = class(TIdBaseComponent) | ||||
|   protected | ||||
|     FConnection: TComponent; | ||||
|     {$IFDEF USE_OBJECT_ARC}[Weak]{$ENDIF} FIntercept: TIdConnectionIntercept; | ||||
|     FIsClient: Boolean; | ||||
|     {$IFDEF USE_OBJECT_ARC} | ||||
|     // When ARC is enabled, object references MUST be valid objects. | ||||
|     // It is common for users to store non-object values, though, so | ||||
|     // we will provide separate properties for those purposes | ||||
|     // | ||||
|     // TODO; use TValue instead of separating them | ||||
|     // | ||||
|     FDataObject: TObject; | ||||
|     FDataValue: PtrInt; | ||||
|     {$ELSE} | ||||
|     FData: TObject; | ||||
|     {$ENDIF} | ||||
| 
 | ||||
|     FOnConnect: TIdInterceptNotifyEvent; | ||||
|     FOnDisconnect: TIdInterceptNotifyEvent; | ||||
|     FOnReceive: TIdInterceptStreamEvent; | ||||
|     FOnSend: TIdInterceptStreamEvent; | ||||
|     // | ||||
|     procedure InitComponent; override; | ||||
|     {$IFNDEF USE_OBJECT_ARC} | ||||
|     procedure Notification(AComponent: TComponent; Operation: TOperation); override; | ||||
|     {$ENDIF} | ||||
|     procedure SetIntercept(AValue: TIdConnectionIntercept); | ||||
|     // | ||||
|   public | ||||
|     procedure Connect(AConnection: TComponent); virtual; | ||||
|     procedure Disconnect; virtual; | ||||
|     procedure Receive(var VBuffer: TIdBytes); virtual; | ||||
|     procedure Send(var VBuffer: TIdBytes); virtual; | ||||
|     // | ||||
|     property Connection: TComponent read FConnection; | ||||
|     property IsClient: Boolean read FIsClient; | ||||
| 
 | ||||
|     // user can use this to keep context | ||||
|     {$IFDEF USE_OBJECT_ARC} | ||||
|     property DataObject: TObject read FDataObject write FDataObject; | ||||
|     property DataValue: PtrInt read FDataValue write FDataValue; | ||||
|     {$ELSE} | ||||
|     property Data: TObject read FData write FData; | ||||
|     {$ENDIF} | ||||
|   published | ||||
|     property Intercept: TIdConnectionIntercept read FIntercept write SetIntercept; | ||||
|     property OnConnect: TIdInterceptNotifyEvent read FOnConnect write FOnConnect; | ||||
|     property OnDisconnect: TIdInterceptNotifyEvent read FOnDisconnect write FOnDisconnect; | ||||
|     property OnReceive: TIdInterceptStreamEvent read FOnReceive write FOnReceive; | ||||
|     property OnSend: TIdInterceptStreamEvent read FOnSend write FOnSend; | ||||
|   end; | ||||
| 
 | ||||
|   TIdServerIntercept = class(TIdBaseComponent) | ||||
|   public | ||||
|     procedure Init; virtual; abstract; | ||||
|     function Accept(AConnection: TComponent): TIdConnectionIntercept; virtual; abstract; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| uses | ||||
|   IdResourceStringsCore; | ||||
| 
 | ||||
| { TIdIntercept } | ||||
| 
 | ||||
| procedure TIdConnectionIntercept.Disconnect; | ||||
| var | ||||
|   // under ARC, convert a weak reference to a strong reference before working with it | ||||
|   LIntercept: TIdConnectionIntercept; | ||||
| begin | ||||
|   LIntercept := Intercept; | ||||
|   if LIntercept <> nil then begin | ||||
|     LIntercept.Disconnect; | ||||
|   end; | ||||
|   if Assigned(OnDisconnect) then begin | ||||
|     OnDisconnect(Self); | ||||
|   end; | ||||
|   FConnection := nil; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdConnectionIntercept.Connect(AConnection: TComponent); | ||||
| var | ||||
|   // under ARC, convert a weak reference to a strong reference before working with it | ||||
|   LIntercept: TIdConnectionIntercept; | ||||
| begin | ||||
|   FConnection := AConnection; | ||||
|   if Assigned(OnConnect) then begin | ||||
|     OnConnect(Self); | ||||
|   end; | ||||
|   LIntercept := Intercept; | ||||
|   if LIntercept <> nil then begin | ||||
|     LIntercept.Connect(AConnection); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdConnectionIntercept.Receive(var VBuffer: TIdBytes); | ||||
| var | ||||
|   // under ARC, convert a weak reference to a strong reference before working with it | ||||
|   LIntercept: TIdConnectionIntercept; | ||||
| begin | ||||
|   LIntercept := Intercept; | ||||
|   if LIntercept <> nil then begin | ||||
|     LIntercept.Receive(VBuffer); | ||||
|   end; | ||||
|   if Assigned(OnReceive) then begin | ||||
|     OnReceive(Self, VBuffer); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdConnectionIntercept.Send(var VBuffer: TIdBytes); | ||||
| var | ||||
|   // under ARC, convert a weak reference to a strong reference before working with it | ||||
|   LIntercept: TIdConnectionIntercept; | ||||
| begin | ||||
|   if Assigned(OnSend) then begin | ||||
|     OnSend(Self, VBuffer); | ||||
|   end; | ||||
|   LIntercept := Intercept; | ||||
|   if LIntercept <> nil then begin | ||||
|     LIntercept.Send(VBuffer); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdConnectionIntercept.SetIntercept(AValue: TIdConnectionIntercept); | ||||
| var | ||||
|   // under ARC, convert a weak reference to a strong reference before working with it | ||||
|   LIntercept: TIdConnectionIntercept; | ||||
|   LNextValue: TIdConnectionIntercept; | ||||
| begin | ||||
|   LIntercept := FIntercept; | ||||
|   if LIntercept <> AValue then | ||||
|   begin | ||||
|     LNextValue := AValue; | ||||
|     while Assigned(LNextValue) do begin | ||||
|       if LNextValue = Self then begin //recursion | ||||
|         raise EIdInterceptCircularLink.CreateFmt(RSInterceptCircularLink, [ClassName]); | ||||
|       end; | ||||
|       LNextValue := LNextValue.Intercept; | ||||
|     end; | ||||
| 
 | ||||
|     // under ARC, all weak references to a freed object get nil'ed automatically | ||||
| 
 | ||||
|     {$IFNDEF USE_OBJECT_ARC} | ||||
|     // remove self from the Intercept's free notification list    {Do not Localize} | ||||
|     if Assigned(LIntercept) then begin | ||||
|       LIntercept.RemoveFreeNotification(Self); | ||||
|     end; | ||||
|     {$ENDIF} | ||||
| 
 | ||||
|     FIntercept := AValue; | ||||
| 
 | ||||
|     {$IFNDEF USE_OBJECT_ARC} | ||||
|     // add self to the Intercept's free notification list    {Do not Localize} | ||||
|     if Assigned(AValue) then begin | ||||
|       AValue.FreeNotification(Self); | ||||
|     end; | ||||
|     {$ENDIF} | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| // under ARC, all weak references to a freed object get nil'ed automatically | ||||
| {$IFNDEF USE_OBJECT_ARC} | ||||
| procedure TIdConnectionIntercept.Notification(AComponent: TComponent; Operation: TOperation); | ||||
| begin | ||||
|   if (Operation = opRemove) and (AComponent = Intercept) then begin | ||||
|     FIntercept := nil; | ||||
|   end; | ||||
|   inherited Notification(AComponent, OPeration); | ||||
| end; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| procedure TIdConnectionIntercept.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FIsClient := True; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										157
									
								
								indy/Core/IdInterceptSimLog.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,157 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.6    7/23/04 6:40:08 PM  RLebeau | ||||
|   Added extra exception handling to Connect() | ||||
| 
 | ||||
|   Rev 1.5    2004.05.20 11:39:10 AM  czhower | ||||
|   IdStreamVCL | ||||
| 
 | ||||
|   Rev 1.4    2004.02.03 4:17:18 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.3    10/19/2003 11:38:26 AM  DSiders | ||||
|   Added localization comments. | ||||
| 
 | ||||
|   Rev 1.2    2003.10.18 1:56:46 PM  czhower | ||||
|   Now uses ASCII instead of binary format. | ||||
| 
 | ||||
|   Rev 1.1    2003.10.17 6:16:20 PM  czhower | ||||
|   Functional complete. | ||||
| } | ||||
| 
 | ||||
| unit IdInterceptSimLog; | ||||
| 
 | ||||
| { | ||||
|   This file uses string outputs instead of binary so that the results can be | ||||
|   viewed and modified with notepad if necessary. | ||||
| 
 | ||||
|   Most times a Send/Receive includes a writeln, but may not always. We write out | ||||
|   an additional EOL to guarantee separation in notepad. | ||||
| 
 | ||||
|   It also auto detects when an EOL can be used instead. | ||||
| 
 | ||||
|   TODO: Can also change it to detect several EOLs and non binary and use :Lines:x | ||||
| } | ||||
| 
 | ||||
| interface | ||||
| {$i IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdGlobal, IdIntercept, IdBaseComponent; | ||||
| 
 | ||||
| type | ||||
|   TIdInterceptSimLog = class(TIdConnectionIntercept) | ||||
|   private | ||||
|   protected | ||||
|     FFilename: string; | ||||
|     FStream: TStream; | ||||
|     // | ||||
|     procedure SetFilename(const AValue: string); | ||||
|     procedure WriteRecord(const ATag: string; const ABuffer: TIdBytes); | ||||
|   public | ||||
|     procedure Connect(AConnection: TComponent); override; | ||||
|     procedure Disconnect; override; | ||||
|     procedure Receive(var ABuffer: TIdBytes); override; | ||||
|     procedure Send(var ABuffer: TIdBytes); override; | ||||
|   published | ||||
|     property Filename: string read FFilename write SetFilename; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF DOTNET} | ||||
|   IdStreamNET, | ||||
|     {$ELSE} | ||||
|   IdStreamVCL, | ||||
|   {$ENDIF} | ||||
|   IdException, IdResourceStringsCore, SysUtils; | ||||
| 
 | ||||
| { TIdInterceptSimLog } | ||||
| 
 | ||||
| procedure TIdInterceptSimLog.Connect(AConnection: TComponent); | ||||
| begin | ||||
|   inherited Connect(AConnection); | ||||
|   // Warning! This will overwrite any existing file. It makes no sense | ||||
|   // to concatenate sim logs. | ||||
|   FStream := TIdFileCreateStream.Create(Filename); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdInterceptSimLog.Disconnect; | ||||
| begin | ||||
|   FreeAndNil(FStream); | ||||
|   inherited Disconnect; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdInterceptSimLog.Receive(var ABuffer: TIdBytes); | ||||
| begin | ||||
|   // let the next Intercept in the chain decode its data first | ||||
|   inherited Receive(ABuffer); | ||||
|   WriteRecord('Recv', ABuffer); {do not localize} | ||||
| end; | ||||
| 
 | ||||
| procedure TIdInterceptSimLog.Send(var ABuffer: TIdBytes); | ||||
| begin | ||||
|   WriteRecord('Send', ABuffer); {do not localize} | ||||
|   // let the next Intercept in the chain encode its data next | ||||
|   inherited Send(ABuffer); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdInterceptSimLog.SetFilename(const AValue: string); | ||||
| begin | ||||
|   if Assigned(FStream) then begin | ||||
|     raise EIdException.Create(RSLogFileAlreadyOpen); | ||||
|   end; | ||||
|   FFilename := AValue; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdInterceptSimLog.WriteRecord(const ATag: string; const ABuffer: TIdBytes); | ||||
| var | ||||
|   i: Integer; | ||||
|   LUseEOL: Boolean; | ||||
|   LSize: Integer; | ||||
| begin | ||||
|   LUseEOL := False; | ||||
|   LSize := Length(ABuffer); | ||||
|   if LSize > 1 then begin | ||||
|     if (ABuffer[LSize - 2] = 13) and (ABuffer[LSize - 1] = 10) then begin | ||||
|       LUseEOL := True; | ||||
|       for i := 0 to LSize - 3 do begin | ||||
|         // If any binary, CR or LF | ||||
|         if (ABuffer[i] < 32) or (ABuffer[i] > 127) then begin | ||||
|           LUseEOL := False; | ||||
|           Break; | ||||
|         end; | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
|   with FStream do begin | ||||
|     if LUseEOL then begin | ||||
|       WriteLn(ATag + ':EOL'); {do not localize} | ||||
|     end else begin | ||||
|       WriteLn(ATag + ':Bytes:' + IntToStr(LSize));  {do not localize} | ||||
|     end; | ||||
|   end; | ||||
|   WriteStringToStream(FStream, ''); | ||||
|   WriteTIdBytesToStream(FStream, ABuffer, LSize); | ||||
|   WriteStringToStream(FStream, EOL); | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										106
									
								
								indy/Core/IdInterceptThrottler.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,106 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.2    2004.02.03 4:17:18 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.1    2003.10.19 12:10:00 AM  czhower | ||||
|   Changed formula to be accurate with smaller numbers. | ||||
| 
 | ||||
|   Rev 1.0    2003.10.18 11:32:00 PM  czhower | ||||
|   Initial checkin | ||||
| 
 | ||||
|   Rev 1.1    2003.10.14 1:27:16 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.0    2003.10.13 6:40:40 PM  czhower | ||||
|   Moved from root | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:55:12 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdInterceptThrottler; | ||||
| 
 | ||||
| interface | ||||
| {$i IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   IdComponent, IdIntercept, IdGlobal; | ||||
| 
 | ||||
| type | ||||
|   TIdInterceptThrottler = class(TIdConnectionIntercept) | ||||
|   protected | ||||
|     FBitsPerSec: Integer; | ||||
|     FRecvBitsPerSec: Integer; | ||||
|     FSendBitsPerSec: Integer; | ||||
|     procedure SetBitsPerSec(AValue: Integer); | ||||
|   public | ||||
|     procedure Receive(var ABuffer: TIdBytes); override; | ||||
|     procedure Send(var ABuffer: TIdBytes); override; | ||||
|   published | ||||
|     property BitsPerSec: Integer read FBitsPerSec write SetBitsPerSec; | ||||
|     property RecvBitsPerSec: Integer read FRecvBitsPerSec write FRecvBitsPerSec; | ||||
|     property SendBitsPerSec: Integer read FSendBitsPerSec write FSendBitsPerSec; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdAntiFreezeBase, IdException; | ||||
| 
 | ||||
| { TIdInterceptThrottler } | ||||
| 
 | ||||
| procedure TIdInterceptThrottler.Receive(var ABuffer: TIdBytes); | ||||
| var | ||||
|   LInterval: Int64; | ||||
| begin | ||||
|   inherited Receive(ABuffer); | ||||
|   if RecvBitsPerSec > 0 then begin | ||||
|     LInterval := (Int64(Length(ABuffer)) * 8 * 1000) div RecvBitsPerSec; | ||||
|     while LInterval > MaxInt do begin | ||||
|       TIdAntiFreezeBase.Sleep(MaxInt); | ||||
|       Dec(LInterval, MaxInt); | ||||
|     end; | ||||
|     TIdAntiFreezeBase.Sleep(Integer(LInterval)); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdInterceptThrottler.Send(var ABuffer: TIdBytes); | ||||
| var | ||||
|   LInterval: Int64; | ||||
| begin | ||||
|   inherited Send(ABuffer); | ||||
|   if SendBitsPerSec > 0 then begin | ||||
|     LInterval := (Int64(Length(ABuffer)) * 8 * 1000) div SendBitsPerSec; | ||||
|     while LInterval > MaxInt do begin | ||||
|       TIdAntiFreezeBase.Sleep(MaxInt); | ||||
|       Dec(LInterval, MaxInt); | ||||
|     end; | ||||
|     TIdAntiFreezeBase.Sleep(Integer(LInterval)); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdInterceptThrottler.SetBitsPerSec(AValue: Integer); | ||||
| begin | ||||
|   FBitsPerSec := AValue; | ||||
|   FRecvBitsPerSec := AValue; | ||||
|   FSendBitsPerSec := AValue; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
| 
 | ||||
							
								
								
									
										198
									
								
								indy/Core/IdLogBase.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,198 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.5    2004.02.03 4:17:14 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.4    2004.01.20 10:03:28 PM  czhower | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.3    2003.10.17 6:15:54 PM  czhower | ||||
|   Upgrades | ||||
| 
 | ||||
|   Rev 1.2    2003.10.14 1:27:08 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.1    6/16/2003 10:39:02 AM  EHill | ||||
|   Done: Expose Open/Close as public in TIdLogBase | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:55:58 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdLogBase; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdIntercept, IdGlobal, IdSocketHandle, IdBaseComponent; | ||||
| 
 | ||||
| type | ||||
|   TIdLogBase = class(TIdConnectionIntercept) | ||||
|   protected | ||||
|     FActive: Boolean; | ||||
|     FLogTime: Boolean; | ||||
|     FReplaceCRLF: Boolean; | ||||
|     FStreamedActive: Boolean; | ||||
|     // | ||||
|     procedure InitComponent; override; | ||||
|     procedure LogStatus(const AText: string); virtual; abstract; | ||||
|     procedure LogReceivedData(const AText, AData: string); virtual; abstract; | ||||
|     procedure LogSentData(const AText, AData: string); virtual; abstract; | ||||
|     procedure SetActive(AValue: Boolean); virtual; | ||||
|     procedure Loaded; override; | ||||
|     function ReplaceCR(const AString : String) : String; | ||||
|   public | ||||
|     procedure Open; virtual; | ||||
|     procedure Close; virtual; | ||||
|     procedure Connect(AConnection: TComponent); override; | ||||
|     destructor Destroy; override; | ||||
|     procedure Disconnect; override; | ||||
|     procedure Receive(var ABuffer: TIdBytes); override; | ||||
|     procedure Send(var ABuffer: TIdBytes); override; | ||||
|   published | ||||
|     property Active: Boolean read FActive write SetActive default False; | ||||
|     property LogTime: Boolean read FLogTime write FLogTime default True; | ||||
|     property ReplaceCRLF: Boolean read FReplaceCRLF write FReplaceCRLF default true; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdResourceStringsCore, SysUtils; | ||||
| 
 | ||||
| const | ||||
|   LOldStr : array [0..2] of string = | ||||
|     ( EOL,  CR, LF ); | ||||
|   LNewStr : array [0..2] of string = | ||||
|     ( RSLogEOL, RSLogCR, RSLogLF ); | ||||
| 
 | ||||
| { TIdLogBase } | ||||
| 
 | ||||
| procedure TIdLogBase.Close; | ||||
| begin | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogBase.Connect(AConnection: TComponent); | ||||
| begin | ||||
|   inherited Connect(AConnection); | ||||
|   if FActive then begin | ||||
|     LogStatus(RSLogConnected); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdLogBase.Destroy; | ||||
| begin | ||||
|   Active := False; | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogBase.Disconnect; | ||||
| begin | ||||
|   if FActive then begin | ||||
|     LogStatus(RSLogDisconnected); | ||||
|   end; | ||||
|   inherited Disconnect; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogBase.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FLogTime := True; | ||||
|   ReplaceCRLF := True; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogBase.Loaded; | ||||
| begin | ||||
|   inherited Loaded; | ||||
|   Active := FStreamedActive; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogBase.Open; | ||||
| begin | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogBase.Receive(var ABuffer: TIdBytes); | ||||
| var | ||||
|   s: string; | ||||
|   LMsg: string; | ||||
| begin | ||||
|   // let the next Intercept in the chain decode its data first | ||||
|   inherited Receive(ABuffer); | ||||
| 
 | ||||
|   if FActive then begin | ||||
|     LMsg := ''; | ||||
|     if LogTime then begin | ||||
|       LMsg := DateTimeToStr(Now); | ||||
|     end; | ||||
|     s := BytesToStringRaw(ABuffer); | ||||
|     if FReplaceCRLF then begin | ||||
|       s := ReplaceCR(S); | ||||
|     end; | ||||
|     LogReceivedData(LMsg, s); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdLogBase.ReplaceCR(const AString: String): String; | ||||
| begin | ||||
|   Result := StringsReplace(AString, LOldStr, LNewStr); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogBase.Send(var ABuffer: TIdBytes); | ||||
| var | ||||
|   s: string; | ||||
|   LMsg: string; | ||||
| begin | ||||
|   if FActive then begin | ||||
|     LMsg := ''; | ||||
|     if LogTime then begin | ||||
|       LMsg := DateTimeToStr(Now); | ||||
|     end; | ||||
|     s := BytesToStringRaw(ABuffer); | ||||
|     if FReplaceCRLF then begin | ||||
|       s := ReplaceCR(S); | ||||
|     end; | ||||
|     LogSentData(LMsg, s); | ||||
|   end; | ||||
| 
 | ||||
|   // let the next Intercept in the chain encode its data next | ||||
|   inherited Send(ABuffer); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogBase.SetActive(AValue: Boolean); | ||||
| begin | ||||
|   if IsDesignTime or IsLoading then begin | ||||
|     FStreamedActive := AValue; | ||||
|   end | ||||
|   else if FActive <> AValue then | ||||
|   begin | ||||
|     FActive := AValue; | ||||
|     if FActive then begin | ||||
|       Open; | ||||
|     end else begin | ||||
|       Close; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
| 
 | ||||
| 
 | ||||
							
								
								
									
										72
									
								
								indy/Core/IdLogDebug.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,72 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.4    8/6/04 12:21:28 AM  RLebeau | ||||
|   Removed TIdLogDebugTarget type, not used anywhere | ||||
| 
 | ||||
|   Rev 1.3    2004.02.03 4:17:16 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.2    2003.10.17 8:17:22 PM  czhower | ||||
|   Removed const | ||||
| 
 | ||||
|   Rev 1.1    4/22/2003 4:34:22 PM  BGooijen | ||||
|   DebugOutput is now in IdGlobal | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:56:02 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdLogDebug; | ||||
| 
 | ||||
| interface | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| uses | ||||
|   IdLogBase; | ||||
| 
 | ||||
| type | ||||
|   TIdLogDebug = class(TIdLogBase) | ||||
|   protected | ||||
|     procedure LogStatus(const AText: string); override; | ||||
|     procedure LogReceivedData(const AText, AData: string); override; | ||||
|     procedure LogSentData(const AText, AData: string); override; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdGlobal; | ||||
| 
 | ||||
| { TIdLogDebug } | ||||
| 
 | ||||
| procedure TIdLogDebug.LogReceivedData(const AText, AData: string); | ||||
| begin | ||||
|   DebugOutput('Recv ' + AText + ': ' + AData);    {Do not Localize} | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogDebug.LogSentData(const AText, AData: string); | ||||
| begin | ||||
|   DebugOutput('Sent ' + AText + ': ' + AData);    {Do not Localize} | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogDebug.LogStatus(const AText: string); | ||||
| begin | ||||
|   DebugOutput('Stat ' + AText);    {Do not Localize} | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										83
									
								
								indy/Core/IdLogEvent.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,83 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.2    2004.05.20 12:34:28 PM  czhower | ||||
|   Removed more non .NET compatible stream read and writes | ||||
| 
 | ||||
|   Rev 1.1    2003.10.17 8:17:22 PM  czhower | ||||
|   Removed const | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:56:08 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdLogEvent; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   IdLogBase, IdBaseComponent, Classes; | ||||
| 
 | ||||
| type | ||||
|   TLogItemStatusEvent = procedure(ASender: TComponent; const AText: string) of object; | ||||
|   TLogItemDataEvent = procedure(ASender: TComponent; const AText, AData: string) of object; | ||||
| 
 | ||||
|   TIdLogEvent = class(TIdLogBase) | ||||
|   protected | ||||
|     FOnReceived: TLogItemDataEvent; | ||||
|     FOnSent: TLogItemDataEvent; | ||||
|     FOnStatus: TLogItemStatusEvent; | ||||
|     // | ||||
|     procedure LogStatus(const AText: string); override; | ||||
|     procedure LogReceivedData(const AText, AData: string); override; | ||||
|     procedure LogSentData(const AText, AData: string); override; | ||||
|   public | ||||
|   published | ||||
|     property OnReceived: TLogItemDataEvent read FOnReceived write FOnReceived; | ||||
|     property OnSent: TLogItemDataEvent read FOnSent write FOnSent; | ||||
|     property OnStatus: TLogItemStatusEvent read FOnStatus write FOnStatus; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| { TIdLogEvent } | ||||
| 
 | ||||
| procedure TIdLogEvent.LogReceivedData(const AText, AData: string); | ||||
| begin | ||||
|   if Assigned(OnReceived) then begin | ||||
|     OnReceived(Self, AText, AData); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogEvent.LogSentData(const AText, AData: string); | ||||
| begin | ||||
|   if Assigned(OnSent) then begin | ||||
|     OnSent(Self, AText, AData); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogEvent.LogStatus(const AText: string); | ||||
| begin | ||||
|   if Assigned(OnStatus) then begin | ||||
|     OnStatus(Self, AText); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										171
									
								
								indy/Core/IdLogFile.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,171 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.8    7/23/04 6:36:54 PM  RLebeau | ||||
|   Added extra exception handling to Open() | ||||
| 
 | ||||
|   Rev 1.7    2004.05.20 12:34:30 PM  czhower | ||||
|   Removed more non .NET compatible stream read and writes | ||||
| 
 | ||||
|   Rev 1.6    2004.02.03 4:17:16 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.5    2003.10.17 6:15:54 PM  czhower | ||||
|   Upgrades | ||||
| 
 | ||||
|   Rev 1.4    2003.10.16 11:24:36 AM  czhower | ||||
|   Bug fix | ||||
| 
 | ||||
|   Rev 1.3    10/15/2003 8:00:10 PM  DSiders | ||||
|   Added resource string for exception raised in TIdLogFile.SetFilename. | ||||
| 
 | ||||
|   Rev 1.2    2003.10.14 1:27:10 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.1    6/16/2003 11:01:06 AM  EHill | ||||
|   Throw exception if the filename is set while the log is open. | ||||
|   Expose Open and Close as public instead of protected. | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:56:12 AM  JPMugaas | ||||
| 
 | ||||
|   19-Aug-2001 DSiders | ||||
|   Fixed bug in Open.  Use file mode fmCreate when Filename does *not* exist. | ||||
| 
 | ||||
|   19-Aug-2001 DSiders | ||||
|   Added protected method TIdLogFile.LogWriteString. | ||||
| 
 | ||||
|   19-Aug-2001 DSiders | ||||
|   Changed implementation of TIdLogFile methods LogStatus, LogReceivedData, and | ||||
|   LogSentData to use LogWriteString. | ||||
| 
 | ||||
|   19-Aug-2001 DSiders | ||||
|   Added class TIdLogFileEx with the LogFormat method. | ||||
| } | ||||
| 
 | ||||
| unit IdLogFile; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdLogBase; | ||||
| 
 | ||||
| type | ||||
|   TIdLogFile = class(TIdLogBase) | ||||
|   protected | ||||
|     FFilename: String; | ||||
|     FFileStream: TStream; | ||||
|     // | ||||
|     procedure LogFormat(const AFormat: string; const AArgs: array of const); virtual; | ||||
|     procedure LogReceivedData(const AText, AData: string); override; | ||||
|     procedure LogSentData(const AText, AData: string); override; | ||||
|     procedure LogStatus(const AText: string); override; | ||||
|     procedure LogWriteString(const AText: string); virtual; | ||||
|     // | ||||
|     procedure SetFilename(const AFilename: String); | ||||
|   public | ||||
|     procedure Open; override; | ||||
|     procedure Close; override; | ||||
|   published | ||||
|     property Filename: String read FFilename write SetFilename; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdGlobal, IdException, IdResourceStringsCore, IdBaseComponent, SysUtils; | ||||
| 
 | ||||
| { TIdLogFile } | ||||
| 
 | ||||
| procedure TIdLogFile.Close; | ||||
| begin | ||||
|   FreeAndNil(FFileStream); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogFile.LogReceivedData(const AText, AData: string); | ||||
| begin | ||||
|   LogWriteString(RSLogRecv + AText + ': ' + AData + EOL);  {Do not translate} | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogFile.LogSentData(const AText, AData: string); | ||||
| begin | ||||
|   LogWriteString(RSLogSent + AText + ': ' + AData + EOL);  {Do not translate} | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogFile.LogStatus(const AText: string); | ||||
| begin | ||||
|   LogWriteString(RSLogStat + AText + EOL); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogFile.Open; | ||||
| begin | ||||
|   if not IsDesignTime then begin | ||||
|     FFileStream := TIdAppendFileStream.Create(Filename); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogFile.LogWriteString(const AText: string); | ||||
| var | ||||
|   LEncoding: IIdTextEncoding; | ||||
| begin | ||||
|   if Assigned(FFileStream) then begin | ||||
|     LEncoding := IndyTextEncoding_8Bit; | ||||
|     WriteStringToStream(FFileStream, AText, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF}); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogFile.LogFormat(const AFormat: string; const AArgs: array of const); | ||||
| var | ||||
|   sPre: string; | ||||
|   sMsg: string; | ||||
|   sData: string; | ||||
| begin | ||||
|   // forces Open to be called prior to Connect | ||||
|   if not Active then begin | ||||
|     Active := True; | ||||
|   end; | ||||
| 
 | ||||
|   sPre := '';   {Do not translate} | ||||
|   sMsg := '';   {Do not translate} | ||||
| 
 | ||||
|   if LogTime then begin | ||||
|     sPre := DateTimeToStr(Now) + ' ';      {Do not translate} | ||||
|   end; | ||||
| 
 | ||||
|   sData := IndyFormat(AFormat, AArgs); | ||||
|   if FReplaceCRLF then begin | ||||
|     sData := ReplaceCR(sData); | ||||
|   end; | ||||
|   sMsg := sPre + sData + EOL; | ||||
| 
 | ||||
|   LogWriteString(sMsg); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogFile.SetFilename(const AFilename: String); | ||||
| begin | ||||
|   if Assigned(FFileStream) then begin | ||||
|     raise EIdException.Create(RSLogFileAlreadyOpen); | ||||
|   end; | ||||
|   FFilename := AFilename; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
| 
 | ||||
							
								
								
									
										118
									
								
								indy/Core/IdLogStream.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,118 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.5    2004.05.20 12:34:32 PM  czhower | ||||
|   Removed more non .NET compatible stream read and writes | ||||
| 
 | ||||
|   Rev 1.4    2004.01.20 10:03:30 PM  czhower | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.3    2003.10.17 6:15:56 PM  czhower | ||||
|   Upgrades | ||||
| 
 | ||||
|   Rev 1.2    2003.10.17 4:28:54 PM  czhower | ||||
|   Changed stream names to be consistent with IOHandlerStream | ||||
| 
 | ||||
|   Rev 1.1    2003.10.14 1:27:12 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 07:56:18 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdLogStream; | ||||
| 
 | ||||
| interface | ||||
| {$I IdCompilerDefines.inc} | ||||
| //Put FPC into Delphi mode | ||||
| uses | ||||
|   Classes, | ||||
|   IdLogBase, IdGlobal; | ||||
| 
 | ||||
| type | ||||
|   TIdLogStream = class(TIdLogBase) | ||||
|   protected | ||||
|     FFreeStreams: Boolean; | ||||
|     FReceiveStream: TStream; | ||||
|     FSendStream: TStream; | ||||
|     // | ||||
|     procedure InitComponent; override; | ||||
|     procedure LogStatus(const AText: string); override; | ||||
|     procedure LogReceivedData(const AText, AData: string); override; | ||||
|     procedure LogSentData(const AText, AData: string); override; | ||||
|   public | ||||
|     procedure Disconnect; override; | ||||
|     // | ||||
|     property FreeStreams: Boolean read FFreeStreams write FFreeStreams; | ||||
|     property ReceiveStream: TStream read FReceiveStream write FReceiveStream; | ||||
|     property SendStream: TStream read FSendStream write FSendStream; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
|  uses SysUtils; | ||||
| 
 | ||||
| // TODO: This was orginally for VCL. For .Net what do we do? Convert back to | ||||
| // 7 bit? Log all? Logging all seems to be a disaster. | ||||
| // Text seems to be best, users are expecting text in this class. But | ||||
| // this write stream will dump unicode out in .net..... | ||||
| // So just convert it again back to 7 bit? How is proper to write | ||||
| // 7 bit to file? Use AnsiString? | ||||
| 
 | ||||
| { TIdLogStream } | ||||
| 
 | ||||
| procedure TIdLogStream.Disconnect; | ||||
| begin | ||||
|   inherited Disconnect; | ||||
|   if FreeStreams then begin | ||||
|     FreeAndNil(FReceiveStream); | ||||
|     FreeAndNil(FSendStream); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogStream.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FFreeStreams := True; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogStream.LogReceivedData(const AText, AData: string); | ||||
| var | ||||
|   LEncoding: IIdTextEncoding; | ||||
| begin | ||||
|   if FReceiveStream <> nil then begin | ||||
|     LEncoding := IndyTextEncoding_8Bit; | ||||
|     WriteStringToStream(FReceiveStream, AData, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF}); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogStream.LogSentData(const AText, AData: string); | ||||
| var | ||||
|   LEncoding: IIdTextEncoding; | ||||
| begin | ||||
|   if FSendStream <> nil then begin | ||||
|     LEncoding := IndyTextEncoding_8Bit; | ||||
|     WriteStringToStream(FSendStream, AData, LEncoding{$IFDEF STRING_IS_ANSI}, LEncoding{$ENDIF}); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdLogStream.LogStatus(const AText: string); | ||||
| begin | ||||
|   // We just leave this empty because the AText is not part of the stream and we | ||||
|   // do not want to raise an abstract method exception. | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										306
									
								
								indy/Core/IdRawBase.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,306 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.15    7/9/04 4:26:28 PM  RLebeau | ||||
|   Removed TIdBytes local variable from Send() | ||||
| 
 | ||||
|   Rev 1.14    09/06/2004 00:28:00  CCostelloe | ||||
|   Kylix 3 patch | ||||
| 
 | ||||
|   Rev 1.13    4/25/2004 7:54:26 AM  JPMugaas | ||||
|   Fix for AV. | ||||
| 
 | ||||
|   Rev 1.12    2/8/2004 12:58:42 PM  JPMugaas | ||||
|   Should now compile in DotNET. | ||||
| 
 | ||||
|   Rev 1.11    2004.02.03 4:16:48 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.10    2/1/2004 6:10:14 PM  JPMugaas | ||||
|   Should compile better. | ||||
| 
 | ||||
|   Rev 1.9    2/1/2004 4:52:34 PM  JPMugaas | ||||
|   Removed the rest of the Todo; items. | ||||
| 
 | ||||
|   Rev 1.8    2004.01.20 10:03:30 PM  czhower | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.7    2004.01.02 9:38:46 PM  czhower | ||||
|   Removed warning | ||||
| 
 | ||||
|   Rev 1.6    2003.10.24 10:09:54 AM  czhower | ||||
|   Compiles | ||||
| 
 | ||||
|   Rev 1.5    2003.10.20 12:03:08 PM  czhower | ||||
|   Added IdStackBSDBase to make it compile again. | ||||
| 
 | ||||
|   Rev 1.4    10/19/2003 10:41:12 PM  BGooijen | ||||
|   Compiles in DotNet and D7 again | ||||
| 
 | ||||
|   Rev 1.3    10/19/2003 9:34:28 PM  BGooijen | ||||
|   SetSocketOption | ||||
| 
 | ||||
|   Rev 1.2    2003.10.11 5:48:58 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.1    2003.09.30 1:23:00 PM  czhower | ||||
|   Stack split for DotNet | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:45:24 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdRawBase; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| { | ||||
|   We need to selectively disable some functionality in DotNET with buffers as | ||||
|   we don't want to impact anything else such as TIdICMPClient. | ||||
| } | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   IdComponent, IdGlobal, IdSocketHandle, IdStack, | ||||
|   {$IFDEF MSWINDOWS} | ||||
|   IdWship6, | ||||
|   {$ENDIF} | ||||
|   IdStackConsts; | ||||
| 
 | ||||
| const | ||||
|   Id_TIdRawBase_Port = 0; | ||||
|   Id_TIdRawBase_BufferSize = 8192; | ||||
|   GReceiveTimeout = 0; | ||||
|   GFTTL = 128; | ||||
| 
 | ||||
| type | ||||
|   TIdRawBase = class(TIdComponent) | ||||
|   protected | ||||
|     FBinding: TIdSocketHandle; | ||||
|     FHost: string; | ||||
|     FPort: TIdPort; | ||||
|     FReceiveTimeout: integer; | ||||
|     FProtocol: TIdSocketProtocol; | ||||
|     FProtocolIPv6 : TIdSocketProtocol; | ||||
|     FTTL: Integer; | ||||
|     FPkt : TIdPacketInfo; | ||||
|     FConnected : Boolean; | ||||
|     // | ||||
|     function GetBinding: TIdSocketHandle; | ||||
|     function GetIPVersion: TIdIPVersion; | ||||
|     // | ||||
|     procedure InitComponent; override; | ||||
|     procedure SetIPVersion(const AValue: TIdIPVersion); | ||||
|     procedure SetTTL(const Value: Integer); | ||||
|     procedure SetHost(const AValue : String); virtual; | ||||
|     // | ||||
|     // TODO: figure out which ReceiveXXX functions we want | ||||
|     // | ||||
|     property IPVersion : TIdIPVersion read GetIPVersion write SetIPVersion; | ||||
|     // | ||||
|     property Port: TIdPort read FPort write FPort default Id_TIdRawBase_Port; | ||||
|     property Protocol: TIdSocketProtocol read FProtocol write FProtocol default Id_IPPROTO_RAW; | ||||
|     property ProtocolIPv6 : TIdSocketProtocol read FProtocolIPv6 write FProtocolIPv6; | ||||
|     property TTL: Integer read FTTL write SetTTL default GFTTL; | ||||
| 
 | ||||
|   public | ||||
|     destructor Destroy; override; | ||||
| 
 | ||||
|     function ReceiveBuffer(var VBuffer : TIdBytes; ATimeOut: Integer = -1): Integer; | ||||
|     procedure Send(const AData: string; AByteEncoding: IIdTextEncoding = nil | ||||
|       {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} | ||||
|       ); overload; virtual; | ||||
|     procedure Send(const AData: TIdBytes); overload;  virtual; | ||||
|     procedure Send(const AHost: string; const APort: TIdPort; const AData: string; | ||||
|       AByteEncoding: IIdTextEncoding = nil | ||||
|       {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} | ||||
|       ); overload; virtual; | ||||
|     procedure Send(const AHost: string; const APort: TIdPort; const ABuffer : TIdBytes); overload; virtual; | ||||
|     // | ||||
|     property Binding: TIdSocketHandle read GetBinding; | ||||
|     property ReceiveTimeout: integer read FReceiveTimeout write FReceiveTimeout Default GReceiveTimeout; | ||||
|   published | ||||
|     property Host: string read FHost write SetHost; | ||||
|   end; | ||||
| 
 | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   SysUtils; | ||||
| 
 | ||||
| { TIdRawBase } | ||||
| 
 | ||||
| destructor TIdRawBase.Destroy; | ||||
| begin | ||||
|   FreeAndNil(FBinding); | ||||
|   FreeAndNil(FPkt); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| function TIdRawBase.GetBinding: TIdSocketHandle; | ||||
| begin | ||||
|   if not FBinding.HandleAllocated then begin | ||||
|     if FBinding.IPVersion = Id_IPv4 then | ||||
|     begin | ||||
|       FBinding.AllocateSocket(Id_SOCK_RAW, FProtocol); | ||||
|     end else | ||||
|     begin | ||||
|       FBinding.AllocateSocket(Id_SOCK_RAW, FProtocolIPv6); | ||||
|       {$IFDEF DOTNET} | ||||
|         {$IFDEF DOTNET_2_OR_ABOVE} | ||||
|       { | ||||
|       Microsoft NET Framework 1.1 may actually have the packetinfo option but that | ||||
|       will not do you any good because you need a RecvMsg function which is not | ||||
|       in NET 1.1.  NET 2.0 does have a RecvMsg function, BTW. | ||||
|       } | ||||
|       //indicate we want packet information with RecvMsg calls | ||||
|       FBinding.SetSockOpt(Id_SOL_IPv6, Id_IPV6_PKTINFO, 1); | ||||
|         {$ENDIF} | ||||
|       {$ELSE} | ||||
|       //indicate we want packet information with RecvMsg WSARecvMsg calls | ||||
|       FBinding.SetSockOpt(Id_SOL_IPv6, Id_IPV6_PKTINFO, 1); | ||||
|       FBinding.SetSockOpt(Id_SOL_IPv6, Id_IPV6_HOPLIMIT, 1); | ||||
|       {$ENDIF} | ||||
|     end; | ||||
|     //set hop limit (or TTL as it was called in IPv4 | ||||
|     FBinding.SetTTL(FTTL); | ||||
|   end; | ||||
|   Result := FBinding; | ||||
| end; | ||||
| 
 | ||||
| function TIdRawBase.ReceiveBuffer(var VBuffer : TIdBytes; ATimeOut: Integer = -1): Integer; | ||||
| var | ||||
|   LIP : String; | ||||
|   LPort : TIdPort; | ||||
|   LIPVersion: TIdIPVersion; | ||||
| begin | ||||
|   Result := 0; | ||||
|   // TODO: pass flags to recv() | ||||
|   if ATimeOut < 0 then | ||||
|   begin | ||||
|     ATimeOut := FReceiveTimeout; | ||||
|   end; | ||||
|   if Length(VBuffer) > 0 then | ||||
|   begin | ||||
|     if Binding.Readable(ATimeOut) then begin | ||||
|       if FBinding.IPVersion = Id_IPv4 then | ||||
|       begin | ||||
|         Result := Binding.RecvFrom(VBuffer, LIP, LPort, LIPVersion); | ||||
|         FPkt.Reset; | ||||
|         FPkt.SourceIP := LIP; | ||||
|         FPkt.SourcePort := LPort; | ||||
|         FPkt.SourceIPVersion := LIPVersion; | ||||
|         FPkt.DestIPVersion := LIPVersion; | ||||
|       end else | ||||
|       begin | ||||
|         { | ||||
|         IMPORTANT!!!! | ||||
| 
 | ||||
|         Do NOT call GStack.ReceiveMsg unless it is absolutely necessary. | ||||
|         The reasons are: | ||||
| 
 | ||||
|         1) WSARecvMsg is only supported on WindowsXP or later.  I think Linux | ||||
|         might have a RecvMsg function as well but I'm not sure. | ||||
|         2) GStack.ReceiveMsg is not supported in the Microsoft NET framework 1.1. | ||||
|         It may be supported in later versions. | ||||
| 
 | ||||
|         For IPv4 and raw sockets, it usually isn't because we get the raw header itself. | ||||
| 
 | ||||
|         For IPv6 and raw sockets, we call this to get information about the destination | ||||
|         IP address and hopefully, the TTL (hop count). | ||||
|         } | ||||
| 
 | ||||
|         Result := GStack.ReceiveMsg(Binding.Handle, VBuffer, FPkt); | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdRawBase.Send(const AHost: string; const APort: TIdPort; const AData: string; | ||||
|   AByteEncoding: IIdTextEncoding = nil | ||||
|   {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} | ||||
|   ); | ||||
| begin | ||||
|   Send(AHost, APort, ToBytes(AData, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF})); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdRawBase.Send(const AData: string; | ||||
|   AByteEncoding: IIdTextEncoding = nil | ||||
|   {$IFDEF STRING_IS_ANSI}; ASrcEncoding: IIdTextEncoding = nil{$ENDIF} | ||||
|   ); | ||||
| begin | ||||
|   Send(ToBytes(AData, AByteEncoding{$IFDEF STRING_IS_ANSI}, ASrcEncoding{$ENDIF})); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdRawBase.Send(const AData: TIdBytes); | ||||
| begin | ||||
|   Send(Host, Port, AData); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdRawBase.Send(const AHost: string; const APort: TIdPort; const ABuffer : TIdBytes); | ||||
| var | ||||
|   LIP : String; | ||||
| begin | ||||
|   LIP := GStack.ResolveHost(AHost, FBinding.IPVersion); | ||||
|   Binding.SendTo(LIP, APort, ABuffer, FBinding.IPVersion); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdRawBase.SetTTL(const Value: Integer); | ||||
| begin | ||||
|   if FTTL <> Value then | ||||
|   begin | ||||
|     FTTL := Value; | ||||
|     if FBinding.HandleAllocated then | ||||
|     begin | ||||
|       FBinding.SetTTL(FTTL); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdRawBase.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FBinding := TIdSocketHandle.Create(nil); | ||||
|   FBinding.IPVersion := Id_IPv4; | ||||
|   FPkt := TIdPacketInfo.Create; | ||||
|   ReceiveTimeout := GReceiveTimeout; | ||||
|   FPort := Id_TIdRawBase_Port; | ||||
|   FProtocol := Id_IPPROTO_RAW; | ||||
|   FTTL := GFTTL; | ||||
| end; | ||||
| 
 | ||||
| function TIdRawBase.GetIPVersion; | ||||
| begin | ||||
|   Result := FBinding.IPVersion; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdRawBase.SetIPVersion(const AValue: TIdIPVersion); | ||||
| begin | ||||
|   FBinding.IPVersion := AValue; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdRawBase.SetHost(const AValue: String); | ||||
| begin | ||||
|   FHost := AValue; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										47
									
								
								indy/Core/IdRawClient.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,47 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.0    11/13/2002 08:45:32 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdRawClient; | ||||
| 
 | ||||
| interface | ||||
| {$i IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   IdGlobal, | ||||
|   IdRawBase; | ||||
| 
 | ||||
| type | ||||
|   TIdRawClient = class(TIdRawBase) | ||||
| 
 | ||||
|   published | ||||
|     property ReceiveTimeout; | ||||
|     property Host; | ||||
|     property Port; | ||||
|     property Protocol; | ||||
|     property ProtocolIPv6; | ||||
|     property IPVersion; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| { TIdRawClient } | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										710
									
								
								indy/Core/IdRawFunctions.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,710 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.5    2004.02.03 4:16:50 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.4    2/1/2004 4:52:30 PM  JPMugaas | ||||
|   Removed the rest of the Todo; items. | ||||
| 
 | ||||
|   Rev 1.3    2/1/2004 4:20:30 PM  JPMugaas | ||||
|   Should work in Win32.  TODO: See about DotNET. | ||||
| 
 | ||||
|   Rev 1.2    2003.10.11 5:49:06 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.1    2003.09.30 1:23:00 PM  czhower | ||||
|   Stack split for DotNet | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:45:36 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdRawFunctions; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$i IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|    IdGlobal, IdRawHeaders, IdStack; | ||||
| 
 | ||||
| // ARP | ||||
| procedure IdRawBuildArp(const AHwAddressFormat, AProtocolFormat: UInt16; | ||||
|   const AHwAddressLen, AProtocolLen: UInt8; const AnOpType: UInt16; | ||||
|   ASenderHw: TIdEtherAddr; ASenderPr: TIdInAddr; ATargetHw: TIdEtherAddr; | ||||
|   ATargetPr: TIdInAddr; const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| 
 | ||||
| // DNS | ||||
| procedure IdRawBuildDns(const AnId, AFlags, ANumQuestions, ANumAnswerRecs, ANumAuthRecs, ANumAddRecs: UInt16; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| 
 | ||||
| // Ethernet | ||||
| procedure IdRawBuildEthernet(ADest, ASource: TIdEtherAddr; AType: UInt16; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| 
 | ||||
| // ICMP | ||||
| procedure IdRawBuildIcmpEcho(AType, ACode: UInt8; AnId, ASeq: UInt16; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| procedure IdRawBuildIcmpMask(AType, ACode: UInt8; AnId, ASeq: UInt16; AMask: UInt32; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| procedure IdRawBuildIcmpRedirect(const AType, ACode: UInt8; AGateway: TIdInAddr; | ||||
|   const AnOrigLen: UInt16; const AnOrigTos: UInt8; const AnOrigId, AnOrigFrag: UInt16; | ||||
|   const AnOrigTtl, AnOrigProtocol: UInt8; AnOrigSource, AnOrigDest: TIdInAddr; | ||||
|   const AnOrigPayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| procedure IdRawBuildIcmpTimeExceed(const AType, ACode: UInt8; const AnOrigLen: UInt16; | ||||
|   const AnOrigTos: UInt8; const AnOrigId, AnOrigFrag: UInt16; | ||||
|   const AnOrigTtl, AnOrigProtocol: UInt8; const AnOrigSource, AnOrigDest: TIdInAddr; | ||||
|   const AnOrigPayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| procedure IdRawBuildIcmpTimestamp(const AType, ACode: UInt8; const AnId, ASeq: UInt16; | ||||
|   const AnOtime, AnRtime, ATtime: TIdNetTime; const APayload: TIdBytes; | ||||
|   var VBuffer: TIdBytes); | ||||
| procedure IdRawBuildIcmpUnreach(AType, ACode: UInt8; AnOrigLen: UInt16; | ||||
|   AnOrigTos: UInt8; AnOrigId, AnOrigFrag: UInt16;  AnOrigTtl, AnOrigProtocol: UInt8; | ||||
|   AnOrigSource, AnOrigDest: TIdInAddr; const AnOrigPayload, APayloadSize: Integer; | ||||
|   var VBuffer: TIdBytes); | ||||
| 
 | ||||
| // IGMP | ||||
| procedure IdRawBuildIgmp(AType, ACode: UInt8; AnIp: TIdInAddr; | ||||
|   const APayload: UInt16; var VBuffer: TIdBytes); | ||||
| 
 | ||||
| // IP | ||||
| procedure IdRawBuildIp(ALen: UInt16; ATos: UInt8; AnId, AFrag: UInt16; | ||||
|   ATtl, AProtocol: UInt8; ASource, ADest: TIdInAddr; const APayload: TIdBytes; | ||||
|   var VBuffer: TIdBytes; const AIdx: Integer = 0); | ||||
| 
 | ||||
| // RIP | ||||
| procedure IdRawBuildRip(const ACommand, AVersion: UInt8; | ||||
|   const ARoutingDomain, AnAddressFamily, ARoutingTag: UInt16; | ||||
|   const AnAddr, AMask, ANextHop, AMetric: UInt32; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| 
 | ||||
| // TCP | ||||
| procedure IdRawBuildTcp(const ASourcePort, ADestPort: UInt16; | ||||
|   const ASeq, AnAck: UInt32; const AControl: UInt8; | ||||
|   const AWindowSize, AnUrgent: UInt16; const APayload: TIdBytes; | ||||
|   var VBuffer: TIdBytes); | ||||
| 
 | ||||
| // UDP | ||||
| procedure IdRawBuildUdp(const ASourcePort, ADestPort: UInt16; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   SysUtils; | ||||
| 
 | ||||
| procedure IdRawBuildArp(const AHwAddressFormat, AProtocolFormat: UInt16; | ||||
|   const AHwAddressLen, AProtocolLen: UInt8; const AnOpType: UInt16; | ||||
|   ASenderHw: TIdEtherAddr; ASenderPr: TIdInAddr; ATargetHw: TIdEtherAddr; | ||||
|   ATargetPr: TIdInAddr; const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrArp: TIdArpHdr; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_ARP_HSIZE + Length(VBuffer); | ||||
|   LLen := Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrArp := TIdArpHdr.Create; | ||||
|   try | ||||
|     HdrArp.arp_hrd := GStack.HostToNetwork(AHwAddressFormat); | ||||
|     HdrArp.arp_pro := GStack.HostToNetwork(AProtocolFormat); | ||||
|     HdrArp.arp_hln := AHwAddressLen; | ||||
|     HdrArp.arp_pln := AProtocolLen; | ||||
|     HdrArp.arp_op  := GStack.HostToNetwork(AnOpType); | ||||
|     HdrArp.arp_sha.CopyFrom(ASenderHw); | ||||
|     HdrArp.arp_spa.s_l := ASenderPr.s_l; | ||||
|     HdrArp.arp_tha.CopyFrom(ATargetHw); | ||||
|     HdrArp.arp_tpa.CopyFrom(ATargetPr); | ||||
| 
 | ||||
|     // copy payload | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, Id_ICMP_ECHO_HSIZE, Length(APayload)); | ||||
|     end; | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrArp.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrArp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildDns(const AnId, AFlags, ANumQuestions, ANumAnswerRecs, | ||||
|   ANumAuthRecs, ANumAddRecs: UInt16; const APayload: TIdBytes; | ||||
|   var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrDns: TIdDnsHdr; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Length(APayload) + Id_DNS_HSIZE; | ||||
|   LLen := UInt32(Length(VBuffer)); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrDns := TIdDnsHdr.Create; | ||||
|   try | ||||
|     HdrDns.dns_id          := GStack.HostToNetwork(AnId); | ||||
|     HdrDns.dns_flags       := GStack.HostToNetwork(AFlags); | ||||
|     HdrDns.dns_num_q       := GStack.HostToNetwork(ANumQuestions); | ||||
|     HdrDns.dns_num_answ_rr := GStack.HostToNetwork(ANumAnswerRecs); | ||||
|     HdrDns.dns_num_auth_rr := GStack.HostToNetwork(ANumAuthRecs); | ||||
|     HdrDns.dns_num_addi_rr := GStack.HostToNetwork(ANumAddRecs); | ||||
| 
 | ||||
|     // copy payload | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, Id_DNS_HSIZE, Length(APayload)); | ||||
|     end; | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrDns.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrDns); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildEthernet(ADest, ASource: TIdEtherAddr; AType: UInt16; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrEth: TIdEthernetHdr; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // make sure VBuffer will be long enough | ||||
|   LIdx := Length(ASource.Data) + Length(ADest.Data) + 2 + Length(APayload); | ||||
|   LLen := Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrEth := TIdEthernetHdr.Create; | ||||
|   try | ||||
|     HdrEth.ether_dhost.CopyFrom(ADest); | ||||
|     HdrEth.ether_shost.CopyFrom(ASource); | ||||
|     HdrEth.ether_type := GStack.HostToNetwork(AType); | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrEth.WriteStruct(VBuffer, LIdx); | ||||
| 
 | ||||
|     // copy payload if present | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, LIdx, Length(APayload)); | ||||
|     end; | ||||
|   finally | ||||
|     FreeAndNil(HdrEth); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| // TODO: check nibbles in IP header | ||||
| procedure IdRawBuildIp(ALen: UInt16; ATos: UInt8; AnId, AFrag: UInt16; ATtl, AProtocol: UInt8; | ||||
|   ASource, ADest: TIdInAddr; const APayload: TIdBytes; var VBuffer: TIdBytes; | ||||
|   const AIdx: Integer = 0); | ||||
| var | ||||
|   HdrIp: TIdIpHdr; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_IP_HSIZE + Length(APayload) + AIdx; | ||||
|   LLen := Length(VBuffer); | ||||
|   if  LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrIp := TIdIpHdr.Create; | ||||
|   try | ||||
|     HdrIp.ip_verlen := (4 shl 4) + (Id_IP_HSIZE div 4);     // IPv4 shl 4, 20 bytes div 4 | ||||
|     HdrIp.ip_tos    := ATos; | ||||
|     HdrIp.ip_len    := GStack.HostToNetwork(UInt16(ALen + Id_IP_HSIZE)); | ||||
|     HdrIp.ip_id     := GStack.HostToNetwork(AnId); | ||||
|     HdrIp.ip_off    := GStack.HostToNetwork(AFrag); | ||||
|     HdrIp.ip_ttl    := ATtl; | ||||
|     HdrIp.ip_p      := AProtocol; | ||||
|     HdrIp.ip_sum    := 0;                                     // do checksum later | ||||
|     HdrIp.ip_src.CopyFrom(ASource); | ||||
|     HdrIp.ip_dst.CopyFrom(ADest); | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := AIdx; | ||||
|     HdrIp.WriteStruct(VBuffer, LIdx); | ||||
| 
 | ||||
|     // copy payload | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, LIdx, Length(APayload)); | ||||
|     end; | ||||
|   finally | ||||
|     FreeANdNil(HdrIp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildIcmpEcho(AType, ACode: UInt8; AnId, ASeq: UInt16; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrIcmp: TIdIcmpHdr; | ||||
|   LIdx, LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_ICMP_ECHO_HSIZE + Length(APayload); | ||||
|   LLen := Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrIcmp := TIdIcmpHdr.Create; | ||||
|   try | ||||
|     HdrIcmp.icmp_type := AType; | ||||
|     HdrIcmp.icmp_code := ACode; | ||||
|     HdrIcmp.icmp_hun.echo_id := GStack.HostToNetwork(AnId); | ||||
|     HdrIcmp.icmp_hun.echo_seq := GStack.HostToNetwork(ASeq); | ||||
| 
 | ||||
|     // copy payload | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, Id_ICMP_ECHO_HSIZE, Length(APayload)); | ||||
|     end; | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrIcmp.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrIcmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| type | ||||
|   TIdICMPMask = class(TIdICMPHdr) | ||||
|   protected | ||||
|     Ficmp_mask: UInt32; | ||||
|     function GetBytesLen: UInt32; override; | ||||
|   public | ||||
|     procedure ReadStruct(const ABytes : TIdBytes; var VIndex : UInt32); override; | ||||
|     procedure WriteStruct(var VBytes : TIdBytes; var VIndex : UInt32); override; | ||||
|     property icmp_mask: UInt32 read Ficmp_mask write Ficmp_mask; | ||||
|   end; | ||||
| 
 | ||||
| function TIdICMPMask.GetBytesLen: UInt32; | ||||
| begin | ||||
|   Result := inherited GetBytesLen + 4; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdICMPMask.ReadStruct(const ABytes : TIdBytes; var VIndex : UInt32); | ||||
| begin | ||||
|   inherited ReadStruct(ABytes, VIndex); | ||||
|   Ficmp_mask := BytesToUInt32(ABytes, VIndex); | ||||
|   Inc(VIndex, 4); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdICMPMask.WriteStruct(var VBytes : TIdBytes; var VIndex : UInt32); | ||||
| begin | ||||
|   inherited WriteStruct(VBytes, VIndex); | ||||
|   CopyTIdUInt32(Ficmp_mask, VBytes, VIndex); | ||||
|   Inc(VIndex, 4); | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildIcmpMask(AType, ACode: UInt8; AnId, ASeq: UInt16; AMask: UInt32; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrIcmp: TIdICMPMask; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_ICMP_MASK_HSIZE + Length(APayload); | ||||
|   LLen := Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrIcmp := TIdICMPMask.Create; | ||||
|   try | ||||
|     HdrIcmp.icmp_type         := AType; | ||||
|     HdrIcmp.icmp_code         := ACode; | ||||
|     HdrIcmp.icmp_hun.echo_id  := GStack.HostToNetwork(AnId); | ||||
|     HdrIcmp.icmp_hun.echo_seq := GStack.HostToNetwork(ASeq); | ||||
|     HdrIcmp.icmp_mask         := GStack.HostToNetwork(AMask); | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrIcmp.WriteStruct(VBuffer, LIdx); | ||||
| 
 | ||||
|     // copy payload | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, LIdx, Length(APayload)); | ||||
|     end; | ||||
|   finally | ||||
|     FreeAndNil(HdrIcmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildIcmpUnreach(AType, ACode: UInt8; AnOrigLen: UInt16; | ||||
|   AnOrigTos: UInt8; AnOrigId, AnOrigFrag: UInt16; AnOrigTtl, AnOrigProtocol: UInt8; | ||||
|   AnOrigSource, AnOrigDest: TIdInAddr; const AnOrigPayload, APayloadSize: Integer; | ||||
|   var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrIcmp: TIdIcmpHdr; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_ICMP_UNREACH_HSIZE + Id_IP_HSIZE + 2; | ||||
|   LLen :=  Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrIcmp := TIdIcmpHdr.Create; | ||||
|   try | ||||
|     HdrIcmp.icmp_type         := AType; | ||||
|     HdrIcmp.icmp_code         := ACode; | ||||
|     HdrIcmp.icmp_hun.echo_id  := 0; | ||||
|     HdrIcmp.icmp_hun.echo_seq := 0; | ||||
| 
 | ||||
|     // attach original header | ||||
|     IdRawBuildIp(0, AnOrigTos, AnOrigId, AnOrigFrag, AnOrigTtl, AnOrigProtocol, | ||||
|       AnOrigSource, AnOrigDest, ToBytes(AnOrigPayload), VBuffer, Id_ICMP_UNREACH_HSIZE); | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrIcmp.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrIcmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildIcmpTimeExceed(const AType, ACode: UInt8; const AnOrigLen: UInt16; | ||||
|   const AnOrigTos: UInt8; const AnOrigId, AnOrigFrag: UInt16; | ||||
|   const AnOrigTtl, AnOrigProtocol: UInt8; const AnOrigSource, AnOrigDest: TIdInAddr; | ||||
|   const AnOrigPayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrIcmp: TIdIcmpHdr; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_ICMP_TIMEXCEED_HSIZE + Id_IP_HSIZE + Length(AnOrigPayload); | ||||
|   Llen := Length(VBuffer); | ||||
|   if Llen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrIcmp := TIdIcmpHdr.Create; | ||||
|   try | ||||
|     HdrIcmp.icmp_type         := AType; | ||||
|     HdrIcmp.icmp_code         := ACode; | ||||
|     HdrIcmp.icmp_hun.echo_id  := 0; | ||||
|     HdrIcmp.icmp_hun.echo_seq := 0; | ||||
| 
 | ||||
|     // attach original header | ||||
|     IdRawBuildIp(0, AnOrigTos, AnOrigId, AnOrigFrag, AnOrigTtl, AnOrigProtocol, | ||||
|       AnOrigSource, AnOrigDest, AnOrigPayload, VBuffer, Id_ICMP_TIMEXCEED_HSIZE); | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrIcmp.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrIcmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| type | ||||
|   TIdIcmpTS = class(TIdIcmpHdr) | ||||
|   protected | ||||
|     Ficmp_dun: TIdicmp_dun; | ||||
|     function GetBytesLen: UInt32; override; | ||||
|   public | ||||
|     constructor Create; override; | ||||
|     destructor Destroy; override; | ||||
|     procedure ReadStruct(const ABytes : TIdBytes; var VIndex : UInt32); override; | ||||
|     procedure WriteStruct(var VBytes : TIdBytes; var VIndex : UInt32); override; | ||||
|     property icmp_dun: TIdicmp_dun read Ficmp_dun; | ||||
|   end; | ||||
| 
 | ||||
| constructor TIdIcmpTS.Create; | ||||
| begin | ||||
|   inherited Create; | ||||
|   Ficmp_dun := TIdicmp_dun.Create; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdIcmpTS.Destroy; | ||||
| begin | ||||
|   Ficmp_dun.Free; | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| function TIdIcmpTS.GetBytesLen: UInt32; | ||||
| begin | ||||
|   Result := inherited GetBytesLen + Ficmp_dun.BytesLen; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIcmpTS.ReadStruct(const ABytes : TIdBytes; var VIndex : UInt32); | ||||
| begin | ||||
|   inherited ReadStruct(ABytes, VIndex); | ||||
|   Ficmp_dun.ReadStruct(ABytes, VIndex); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdIcmpTS.WriteStruct(var VBytes : TIdBytes; var VIndex : UInt32); | ||||
| begin | ||||
|   inherited WriteStruct(VBytes, VIndex); | ||||
|   Ficmp_dun.WriteStruct(VBytes, VIndex); | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildIcmpTimestamp(const AType, ACode: UInt8; const AnId, ASeq: UInt16; | ||||
|   const AnOtime, AnRtime, ATtime: TIdNetTime; const APayload: TIdBytes; | ||||
|   var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrIcmp: TIdIcmpTS; | ||||
|   LIdx, LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_ICMP_TS_HSIZE + Length(APayload); | ||||
|   LLen := Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrIcmp := TIdIcmpTS.Create; | ||||
|   try | ||||
|     HdrIcmp.icmp_type             := AType; | ||||
|     HdrIcmp.icmp_code             := ACode; | ||||
|     HdrIcmp.icmp_hun.echo_id      := GStack.HostToNetwork(AnId); | ||||
|     HdrIcmp.icmp_hun.echo_seq     := GStack.HostToNetwork(ASeq); | ||||
|     HdrIcmp.icmp_dun.ts_otime     := GStack.HostToNetwork(AnOtime);      // original timestamp | ||||
|     HdrIcmp.icmp_dun.ts_rtime     := GStack.HostToNetwork(AnRtime);      // receive timestamp | ||||
|     HdrIcmp.icmp_dun.ts_ttime     := GStack.HostToNetwork(ATtime);       // transmit timestamp | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrIcmp.WriteStruct(VBuffer, LIdx); | ||||
| 
 | ||||
|     // copy payload | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, LIdx, Length(APayload)); | ||||
|     end; | ||||
|   finally | ||||
|     FreeAndNil(HdrIcmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildIcmpRedirect(const AType, ACode: UInt8; AGateway: TIdInAddr; | ||||
|   const AnOrigLen: UInt16; const AnOrigTos: UInt8; const AnOrigId, AnOrigFrag: UInt16; | ||||
|   const AnOrigTtl, AnOrigProtocol: UInt8; AnOrigSource, AnOrigDest: TIdInAddr; | ||||
|   const AnOrigPayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrIcmp: TIdIcmpHdr; | ||||
|   LIdx, LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_ICMP_REDIRECT_HSIZE + Id_IP_HSIZE + Length(AnOrigPayload); | ||||
|   LLen := Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrIcmp := TIdIcmpHdr.Create; | ||||
|   try | ||||
|     HdrIcmp.icmp_type             := AType; | ||||
|     HdrIcmp.icmp_code             := ACode; | ||||
|     HdrIcmp.icmp_hun.gateway_s_b1 := AGateway.s_l;      // gateway address | ||||
| 
 | ||||
|     // attach original header | ||||
|     IdRawBuildIp(0, AnOrigTos, AnOrigId, AnOrigFrag, AnOrigTtl, AnOrigProtocol, | ||||
|       AnOrigSource, AnOrigDest, AnOrigPayload, VBuffer, Id_ICMP_REDIRECT_HSIZE); | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrIcmp.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrIcmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildIgmp(AType, ACode: UInt8; AnIp: TIdInAddr; | ||||
|   const APayload: UInt16; var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrIgmp: TIdIgmpHdr; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := 2 + Id_IGMP_HSIZE; | ||||
|   LLen := Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrIgmp := TIdIgmpHdr.Create; | ||||
|   try | ||||
|     HdrIgmp.igmp_type         := AType; | ||||
|     HdrIgmp.igmp_code         := ACode; | ||||
|     HdrIgmp.igmp_sum          := 0; | ||||
|     HdrIgmp.igmp_group.s_l    := AnIp.s_l;      // group address or 0 | ||||
| 
 | ||||
|     // copy payload | ||||
|     CopyTIdUInt16(APayload, VBuffer, Id_IGMP_HSIZE); | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrIgmp.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrIgmp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildRip(const ACommand, AVersion: UInt8; | ||||
|   const ARoutingDomain, AnAddressFamily, ARoutingTag: UInt16; | ||||
|   const AnAddr, AMask, ANextHop, AMetric: UInt32; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrRip: TIdRipHdr; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_RIP_HSIZE + Length(APayload); | ||||
|   LLen := Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrRip := TIdRipHdr.Create; | ||||
|   try | ||||
|     HdrRip.rip_cmd      := ACommand; | ||||
|     HdrRip.rip_ver      := AVersion; | ||||
|     HdrRip.rip_rd       := GStack.HostToNetwork(ARoutingDomain); | ||||
|     HdrRip.rip_af       := GStack.HostToNetwork(AnAddressFamily); | ||||
|     HdrRip.rip_rt       := GStack.HostToNetwork(ARoutingTag); | ||||
|     HdrRip.rip_addr     := GStack.HostToNetwork(AnAddr); | ||||
|     HdrRip.rip_mask     := GStack.HostToNetwork(AMask); | ||||
|     HdrRip.rip_next_hop := GStack.HostToNetwork(ANextHop); | ||||
|     HdrRip.rip_metric   := GStack.HostToNetwork(AMetric); | ||||
| 
 | ||||
|     // copy payload | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, Id_RIP_HSIZE, Length(APayload)); | ||||
|     end; | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrRip.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrRip); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| // TODO: check nibbles in TCP header | ||||
| procedure IdRawBuildTcp(const ASourcePort, ADestPort: UInt16; | ||||
|   const ASeq, AnAck: UInt32; const AControl: UInt8; | ||||
|   const AWindowSize, AnUrgent: UInt16; const APayload: TIdBytes; | ||||
|   var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrTcp: TIdTcpHdr; | ||||
|   LIdx, LLen: UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_TCP_HSIZE + Length(VBuffer); | ||||
|   LLen :=  Length(VBuffer); | ||||
|   if LLen < LIdx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrTcp := TIdTcpHdr.Create; | ||||
|   try | ||||
|     HdrTcp.tcp_sport    := GStack.HostToNetwork(ASourcePort); | ||||
|     HdrTcp.tcp_dport    := GStack.HostToNetwork(ADestPort); | ||||
|     HdrTcp.tcp_seq      := GStack.HostToNetwork(ASeq); | ||||
|     HdrTcp.tcp_ack      := GStack.HostToNetwork(AnAck);                // acknowledgement number | ||||
|     HdrTcp.tcp_flags    := AControl;                              // control flags | ||||
|     HdrTcp.tcp_x2off    := ((Id_TCP_HSIZE div 4) shl 4) + 0;      // 20 bytes div 4, x2 unused | ||||
|     HdrTcp.tcp_win      := GStack.HostToNetwork(AWindowSize);          // window size | ||||
|     HdrTcp.tcp_sum      := 0; | ||||
|     HdrTcp.tcp_urp      := AnUrgent;                              // urgent pointer | ||||
| 
 | ||||
|     // copy payload | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, Id_TCP_HSIZE, Length(APayload)); | ||||
|     end; | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrTcp.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrTcp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure IdRawBuildUdp(const ASourcePort, ADestPort: UInt16; | ||||
|   const APayload: TIdBytes; var VBuffer: TIdBytes); | ||||
| var | ||||
|   HdrUdp: TIdUdpHdr; | ||||
|   LIdx: UInt32; | ||||
|   LLen : UInt32; | ||||
| begin | ||||
|   // check input | ||||
|   LIdx := Id_UDP_HSIZE + Length(APayload); | ||||
|   LLen := Length(VBuffer); | ||||
|   if LLen < Lidx then begin | ||||
|     SetLength(VBuffer, LIdx); | ||||
|   end; | ||||
| 
 | ||||
|   // construct header | ||||
|   HdrUdp := TIdUdpHdr.Create; | ||||
|   try | ||||
|     HdrUdp.udp_dport    := GStack.HostToNetwork(ASourcePort); | ||||
|     HdrUdp.udp_dport    := GStack.HostToNetwork(ADestPort); | ||||
|     //LIdx should be okay here since we set that to the packet length earlier | ||||
|     HdrUdp.udp_ulen     := GStack.HostToNetwork(LIdx); | ||||
|     HdrUdp.udp_sum      := 0; | ||||
| 
 | ||||
|     // copy payload | ||||
|     if Length(APayload) > 0 then begin | ||||
|       CopyTIdBytes(APayload, 0, VBuffer, Id_UDP_HSIZE, Length(APayload)); | ||||
|     end; | ||||
| 
 | ||||
|     // copy header | ||||
|     LIdx := 0; | ||||
|     HdrUdp.WriteStruct(VBuffer, LIdx); | ||||
|   finally | ||||
|     FreeAndNil(HdrUdp); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										1746
									
								
								indy/Core/IdRawHeaders.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						
							
								
								
									
										675
									
								
								indy/Core/IdRegisterCore.lrs
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,675 @@ | ||||
| LazarusResources.Add('TIdTCPClient','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040404040404040404040404040' | ||||
|   +'5",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"0504' | ||||
|   +'03030303030303030303030303030315151515150404",'#13#10'"05041111111111111111' | ||||
|   +'1111111111110315151515150404",'#13#10'"050411111111111111111111111111031515' | ||||
|   +'151515150404",'#13#10'"050403030303030303030311111103151515151515150404",' | ||||
|   +#13#10'"050415151515151515031111110303030303030303030404",'#13#10'"050415151' | ||||
|   +'515151503111111111111111111111111110404",'#13#10'"0504151515151503111111111' | ||||
|   +'11111111111111111110404",'#13#10'"05041515151515030303030303030303030303030' | ||||
|   +'3030404",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10 | ||||
|   +'"050415151515151515151515151515151515151515150404",'#13#10'"050415000000000' | ||||
|   +'000150000000000150000000000150404",'#13#10'"0504151515000015151500001515151' | ||||
|   +'50000150000150404",'#13#10'"05041515150000151515000015151515000015000015040' | ||||
|   +'4",'#13#10'"050415151500001515150000151515150000000000150404",'#13#10'"0504' | ||||
|   +'15151500001515150000151515150000151515150404",'#13#10'"05041515150000151515' | ||||
|   +'0000151515150000151515150404",'#13#10'"050415151500001515150000000000150000' | ||||
|   +'151515150404",'#13#10'"050415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"050404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdUDPClient','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c none",' | ||||
|   +#13#10'"04 c #000080",'#13#10'"05 c #800080",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0303030303030303030303030303030' | ||||
|   +'30303030303030303",'#13#10'"03030404040404040404040404040404040404040404040' | ||||
|   +'3",'#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"0304' | ||||
|   +'08080808080808080808080808080815151515150404",'#13#10'"03040707070707070707' | ||||
|   +'0707070707070815151515150404",'#13#10'"030407070707070707070707070707081515' | ||||
|   +'151515150404",'#13#10'"030408080808080808080807070708151515151515150404",' | ||||
|   +#13#10'"030415151515151515080707070808080808080808080404",'#13#10'"030415151' | ||||
|   +'515151508070707070707070707070707070404",'#13#10'"0304151515151508070707070' | ||||
|   +'70707070707070707070404",'#13#10'"03041515151515080808080808080808080808080' | ||||
|   +'8080404",'#13#10'"030415151515151515151515151515151515151515150404",'#13#10 | ||||
|   +'"030415151515151515151515151515151515151515150404",'#13#10'"030415000015150' | ||||
|   +'000150000000015150000000000150404",'#13#10'"0304150000151500001500001500001' | ||||
|   +'50000150000150404",'#13#10'"03041500001515000015000015000015000015000015040' | ||||
|   +'4",'#13#10'"030415000015150000150000150000150000000000150404",'#13#10'"0304' | ||||
|   +'15000015150000150000150000150000151515150404",'#13#10'"03041500001515000015' | ||||
|   +'0000150000150000151515150404",'#13#10'"030415150000000015150000000015150000' | ||||
|   +'151515150404",'#13#10'"030415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"030404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0303040404040404040404040' | ||||
|   +'40404040404040404040403"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdCmdTCPClient','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c none",' | ||||
|   +#13#10'"04 c #000080",'#13#10'"05 c #800080",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #808080",'#13#10'"08 c #C0C0C0",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0303030303030303030303030303030' | ||||
|   +'30303030303030303",'#13#10'"03030404040404040404040404040404040404040404040' | ||||
|   +'3",'#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"0304' | ||||
|   +'15151515151515151515151515151515151515150404",'#13#10'"03041515151515151515' | ||||
|   +'1515151515151515151515150404",'#13#10'"030415151515151515151515151515151515' | ||||
|   +'151515150404",'#13#10'"030415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"030415070000000015000008150800000000000007150404",'#13#10'"030400000' | ||||
|   +'815080015150007150700151500000800000404",'#13#10'"0304000015151515151500001' | ||||
|   +'50000151500001500000404",'#13#10'"03040000151515151515000707070015150000150' | ||||
|   +'0000404",'#13#10'"030400001515151515150008000800151500001500000404",'#13#10 | ||||
|   +'"030400000815080015150015071500151500000800000404",'#13#10'"030415070000000' | ||||
|   +'815000000150000000000000007150404",'#13#10'"0304151515151515151515151515151' | ||||
|   +'51515151515150404",'#13#10'"03041515151515151515151515151515151515151515040' | ||||
|   +'4",'#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"0304' | ||||
|   +'15151515151515151515151515151515151515150404",'#13#10'"03041515151515151515' | ||||
|   +'1515151515151515151515150404",'#13#10'"030415151515151515151515151515151515' | ||||
|   +'151515150404",'#13#10'"030415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"030404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0303040404040404040404040' | ||||
|   +'40404040404040404040403"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdIPMCastClient','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040404040404040404040404040' | ||||
|   +'5",'#13#10'"050415151515151515080808080808151515151515150404",'#13#10'"0504' | ||||
|   +'15151515150808150708070707080715151515150404",'#13#10'"05041515151507070708' | ||||
|   +'0707070708070707151515150404",'#13#10'"050415151515080707070708080815080708' | ||||
|   +'151515150404",'#13#10'"050415151508150815080715070707150815081515150404",' | ||||
|   +#13#10'"050415151508070708150708080707080707081515150404",'#13#10'"050415151' | ||||
|   +'508080708070807070707080707081515150404",'#13#10'"0504151515080815080707080' | ||||
|   +'70815080708081515150404",'#13#10'"05041515150807070815070808150708070708151' | ||||
|   +'5150404",'#13#10'"050415151508150807081500001508150815081515150404",'#13#10 | ||||
|   +'"050415151507070707150800000715070708071515150404",'#13#10'"050415151515080' | ||||
|   +'708070800000708081508151515150404",'#13#10'"0504151515151508071500000008150' | ||||
|   +'70815151515150404",'#13#10'"05041515151515151507000808001507151515151515040' | ||||
|   +'4",'#13#10'"050415151515151515080000000015151515151515150404",'#13#10'"0504' | ||||
|   +'15151515151515000008070007151515151515150404",'#13#10'"05041515151515150700' | ||||
|   +'0700080008151515151515150404",'#13#10'"050415151515151507000800080008151515' | ||||
|   +'151515150404",'#13#10'"050415151515151508000808150000071515151515150404",' | ||||
|   +#13#10'"050415151515151500080800080800071515151515150404",'#13#10'"050404040' | ||||
|   +'404040700070800001500080404040404040404",'#13#10'"0505040404040407000808080' | ||||
|   +'70008080404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdIOHandlerStack','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050008000004040004040004040000070404040404040' | ||||
|   +'5",'#13#10'"050408080708121212121212121212040815151515150704",'#13#10'"0504' | ||||
|   +'08080700120412041204120412040815151515150404",'#13#10'"05040007080808080808' | ||||
|   +'0808080808030815151515150404",'#13#10'"050408151515151515151515151515080815' | ||||
|   +'151515150704",'#13#10'"050408151507070707070708151515080815151515150404",' | ||||
|   +#13#10'"050408150707070708070708081515080815151515150404",'#13#10'"050408070' | ||||
|   +'707070800080707080815080815151515150704",'#13#10'"0504081507070708080807070' | ||||
|   +'80815080815151515150404",'#13#10'"05040807070708080707000708081508081515151' | ||||
|   +'5150704",'#13#10'"050408150707080807080807030807080815151515150404",'#13#10 | ||||
|   +'"050408150707080807080808080707000807151515150704",'#13#10'"050408071508080' | ||||
|   +'807080808081515070008070715150404",'#13#10'"0504081515150800080008080407150' | ||||
|   +'80808150807150404",'#13#10'"05040815151515151515151508000708070707070708040' | ||||
|   +'4",'#13#10'"050408070707070707070707070800070707070707080704",'#13#10'"0504' | ||||
|   +'08000800080008000803040308070707070707080804",'#13#10'"05041515151507151515' | ||||
|   +'0715070808080707070707080704",'#13#10'"050415151515151515151515150708080707' | ||||
|   +'070707000704",'#13#10'"050415151515151515151515151508080808080807080704",' | ||||
|   +#13#10'"050415151515151515151515151515080800080008070804",'#13#10'"050404040' | ||||
|   +'404040404040404040404040707070708070704",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdIOHandlerStream','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505000000050' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040008040404040404040404040' | ||||
|   +'5",'#13#10'"050415151515151515150306061515151515151515150404",'#13#10'"0504' | ||||
|   +'15151515151515151506060615151515151515150404",'#13#10'"05041515151515151515' | ||||
|   +'1500061206151515151515150404",'#13#10'"050415151515150715151504060606081515' | ||||
|   +'151515150404",'#13#10'"050415151515150800150006040604071515151515150404",' | ||||
|   +#13#10'"050415151515151508000604060600151515151515150404",'#13#10'"050415151' | ||||
|   +'515150006060606040015151515151515150404",'#13#10'"0504151515150406061206060' | ||||
|   +'60015151515151515150404",'#13#10'"05041515150006060606061206081515151515151' | ||||
|   +'5150404",'#13#10'"050415151506060406120606060300151515151515150404",'#13#10 | ||||
|   +'"050415150004060406060606120015151515151515150404",'#13#10'"050415150603060' | ||||
|   +'400061207070015001508151515150404",'#13#10'"0504151506080606060604060600031' | ||||
|   +'50002031515150404",'#13#10'"05041515000604061206060606060608000015151515040' | ||||
|   +'4",'#13#10'"050415150006060406060604061206060000151515150404",'#13#10'"0504' | ||||
|   +'15151504060806060606060606060606000815150404",'#13#10'"05041515150006080006' | ||||
|   +'0406040006040612060615150404",'#13#10'"050415151515060002060408060604000606' | ||||
|   +'060615150404",'#13#10'"050415151515030606020006060604000604040615150404",' | ||||
|   +#13#10'"050415151515150302000008040606061206061515150404",'#13#10'"050404040' | ||||
|   +'404040404000606060604040608040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdServerIOHandlerStack','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505000000000000000505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050015151515150004040004040000070404040404040' | ||||
|   +'5",'#13#10'"050400151414141500121212121212040815151515150704",'#13#10'"0504' | ||||
|   +'00151414141500041204120412040815151515150404",'#13#10'"05040015080808080008' | ||||
|   +'0808080808030815151515150404",'#13#10'"050400000000000000151515151515080815' | ||||
|   +'151515150704",'#13#10'"000000151507070700000008151515080815151515150404",' | ||||
|   +#13#10'"001515070707070707080008081515080815151515150404",'#13#10'"001508080' | ||||
|   +'808080808080007080815080815151515150704",'#13#10'"0000000000000000000000070' | ||||
|   +'80815080815151515150404",'#13#10'"05040807070708080707000708081508081515151' | ||||
|   +'5150704",'#13#10'"050408150707080807080807030807080815151515150404",'#13#10 | ||||
|   +'"050408150707080807080808080707000807151515150704",'#13#10'"050408071508080' | ||||
|   +'807080808081515070008070715150404",'#13#10'"0504081515150800080008080407150' | ||||
|   +'80808150807150404",'#13#10'"05040815151515151515151508000708070707070708040' | ||||
|   +'4",'#13#10'"050408070707070707070707070800070707070707080704",'#13#10'"0504' | ||||
|   +'08000800080008000803040308070707070707080804",'#13#10'"05041515151507151515' | ||||
|   +'0715070808080707070707080704",'#13#10'"050415151515151515151515150708080707' | ||||
|   +'070707000704",'#13#10'"050415151515151515151515151508080808080807080704",' | ||||
|   +#13#10'"050415151515151515151515151515080800080008070804",'#13#10'"050404040' | ||||
|   +'404040404040404040404040707070708070704",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdConnectionIntercept','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040404040404040404040404040' | ||||
|   +'5",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"0504' | ||||
|   +'15151515150215151515151515151515151515150404",'#13#10'"05040303030302020303' | ||||
|   +'0303030303030303030303030404",'#13#10'"050415151502020215151515151515151515' | ||||
|   +'151515150404",'#13#10'"050415150202020202020202020202151515151515150404",' | ||||
|   +#13#10'"050415150202020202020202020202021515151515150404",'#13#10'"050415151' | ||||
|   +'502020215151515151515020215151515150404",'#13#10'"0504151515150202151515151' | ||||
|   +'51515150202151515150404",'#13#10'"05041515151515021515151515151515150202151' | ||||
|   +'5150404",'#13#10'"050415151515151515151509090909090909090909150404",'#13#10 | ||||
|   +'"050415151515151515151509090909090909090909150404",'#13#10'"050415150215151' | ||||
|   +'515151515151515151502021515150404",'#13#10'"0504151502021515151515151515151' | ||||
|   +'50202151515150404",'#13#10'"05041515020202151515151515151502021515151515040' | ||||
|   +'4",'#13#10'"050415150202020202020202020202021515151515150404",'#13#10'"0504' | ||||
|   +'15150202020202020202020202151515151515150404",'#13#10'"05041515020202151515' | ||||
|   +'1515151515151515151515150404",'#13#10'"050415150202151515151515151515151515' | ||||
|   +'151515150404",'#13#10'"050415150215151515151515151515151515151515150404",' | ||||
|   +#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"050404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdInterceptSimLog','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040404040404040404040404040' | ||||
|   +'5",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"0504' | ||||
|   +'15151515151515151515151515151515151515150404",'#13#10'"05040303030303000300' | ||||
|   +'0300030003000303030303030404",'#13#10'"050415151515001500080008000800080015' | ||||
|   +'151515150404",'#13#10'"050415151500151500080008000800080015151515150404",' | ||||
|   +#13#10'"050415151500150000150015001500150000151515150404",'#13#10'"050415151' | ||||
|   +'500150015151515151515151500151515150404",'#13#10'"0504151515001500151414141' | ||||
|   +'41414141500151515150404",'#13#10'"05041515150015001515080815081515150015151' | ||||
|   +'5150404",'#13#10'"050415151500150015141414141414141500151515150404",'#13#10 | ||||
|   +'"050415151500150015150815080808151500151515150404",'#13#10'"050415151500150' | ||||
|   +'015141414141414141500151515150404",'#13#10'"0504151515001500151508080815151' | ||||
|   +'51500151515150404",'#13#10'"05041515150015001514141414141414150015151515040' | ||||
|   +'4",'#13#10'"050415151500150015151515151515151500151515150404",'#13#10'"0504' | ||||
|   +'15151500150015141414141414141500151515150404",'#13#10'"05041515151500001515' | ||||
|   +'1515151515151500151515150404",'#13#10'"050415151515151500000000000000000015' | ||||
|   +'151515150404",'#13#10'"050415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"050404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdInterceptThrottler','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050707070707070707070707070' | ||||
|   +'70707070708050505",'#13#10'"05050407151515151515151515151515151515150704040' | ||||
|   +'5",'#13#10'"050415071507071507071507071507071507071507150404",'#13#10'"0504' | ||||
|   +'15071508070708070807070707070707081507150404",'#13#10'"05040307150708070808' | ||||
|   +'0708080708070815070707030404",'#13#10'"050415071508080707150708070708070708' | ||||
|   +'081507150404",'#13#10'"050415071515151515151515151515151515151507150404",' | ||||
|   +#13#10'"050415071515151515151515151507150715151507150404",'#13#10'"050415071' | ||||
|   +'515070715080807070808070807151507150404",'#13#10'"0504150715151507150807080' | ||||
|   +'70807150815151507150404",'#13#10'"05041507151507080708070807080715081515150' | ||||
|   +'7150404",'#13#10'"050415071515151515151515151515151515151507150404",'#13#10 | ||||
|   +'"050415071515150804030407150700080815151507150404",'#13#10'"050415071515150' | ||||
|   +'007070715150015070015151507150404",'#13#10'"0504150715151500151515150708151' | ||||
|   +'50808151507150404",'#13#10'"05041507151507000800081508081515080815150715040' | ||||
|   +'4",'#13#10'"050415071515150815150007080815150808151507150404",'#13#10'"0504' | ||||
|   +'15071515151515150808080815150808151507150404",'#13#10'"05041507151508081515' | ||||
|   +'0808070015150808151507150404",'#13#10'"050415071515150008080015150808080015' | ||||
|   +'151507150404",'#13#10'"050415071515151508071515151508071515151507150404",' | ||||
|   +#13#10'"050415071515151515151515151515151515151507150404",'#13#10'"050404071' | ||||
|   +'515151515151515151515151515151507040404",'#13#10'"0505040707070707070707070' | ||||
|   +'70707070707070707040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdLogDebug','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040404040404040404040404040' | ||||
|   +'5",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"0504' | ||||
|   +'15151515151515151515151515151515151515150404",'#13#10'"05040303030303030303' | ||||
|   +'0303030303030303030303030404",'#13#10'"050415151515151507151515151515151515' | ||||
|   +'151515150404",'#13#10'"050415151515151507070715150707151515151515150404",' | ||||
|   +#13#10'"050415151515151507080808080708151515151515150404",'#13#10'"050415151' | ||||
|   +'515151507080803030808071515151515150404",'#13#10'"0504151515151515070901010' | ||||
|   +'10108071515151515150404",'#13#10'"05041515151515070808080909010108151515151' | ||||
|   +'5150404",'#13#10'"050415151507080708010109010101080807151515150404",'#13#10 | ||||
|   +'"050415151508070801010109010101080708151515150404",'#13#10'"050415150707070' | ||||
|   +'808000909090100030708071515150404",'#13#10'"0504151515151508080101010101080' | ||||
|   +'80807071515150404",'#13#10'"05041515151515080708000000000807080815151515040' | ||||
|   +'4",'#13#10'"050415151515080707150708070807151508151515150404",'#13#10'"0504' | ||||
|   +'15151515150707151515151515151515151515150404",'#13#10'"05041515151515151515' | ||||
|   +'1515151515151515151515150404",'#13#10'"050415151515151515151515151515151515' | ||||
|   +'151515150404",'#13#10'"050415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"050404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdLogEvent','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505051215150' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040412151504040404040404040' | ||||
|   +'5",'#13#10'"050411111111111111111111121515111111111111110404",'#13#10'"0504' | ||||
|   +'11111111111111111111151512111111111111110404",'#13#10'"05040303030303030303' | ||||
|   +'0303151512030303030303030404",'#13#10'"050411111111111111111212151512111111' | ||||
|   +'111111110404",'#13#10'"050411111111111111121215151515111111111111110404",' | ||||
|   +#13#10'"050412121111111111121515121215121212111111110404",'#13#10'"050412121' | ||||
|   +'212111112121512111215151515121111110404",'#13#10'"0504121412151215151512121' | ||||
|   +'11112151212151515110404",'#13#10'"05041215151515151215120111111215151212121' | ||||
|   +'2110404",'#13#10'"050412151212121212151211111111121515121311110404",'#13#10 | ||||
|   +'"050411111111111214121111111111121512151212110404",'#13#10'"050411111111121' | ||||
|   +'215121201111111121512151515121204",'#13#10'"0504111111121515151512121111111' | ||||
|   +'21512121215151212",'#13#10'"05041111111212121112151511111215151511121512131' | ||||
|   +'2",'#13#10'"050411121214120111121215111112151215111215110404",'#13#10'"0504' | ||||
|   +'11121515121111121415111112121215111215120404",'#13#10'"05041215121201121215' | ||||
|   +'1512111215121415121212151512",'#13#10'"050412121201111215151212111215121212' | ||||
|   +'121112121515",'#13#10'"121214120111111215121201111215111112120811121212",' | ||||
|   +#13#10'"121512121111111215111111111111111112151212110404",'#13#10'"121512010' | ||||
|   +'404041215040404040404040404151512010404",'#13#10'"0515120404040412150404040' | ||||
|   +'40404040404121512040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdLogFile','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040404040404040404040404040' | ||||
|   +'5",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"0504' | ||||
|   +'15151515151515151515151515151515151515150404",'#13#10'"05040303030000090909' | ||||
|   +'0909090909090000030303030404",'#13#10'"050415150000001515151515151515150000' | ||||
|   +'001515150404",'#13#10'"050415150000001515151515151515150008001515150404",' | ||||
|   +#13#10'"050415150000001515151515151515150000001515150404",'#13#10'"050415150' | ||||
|   +'000001515151515151515150000001515150404",'#13#10'"0504151500000015151515151' | ||||
|   +'51515150000001515150404",'#13#10'"05041515000000151515151515151515000000151' | ||||
|   +'5150404",'#13#10'"050415150000001515151515151515150000001515150404",'#13#10 | ||||
|   +'"050415150000000000000000000000000000001515150404",'#13#10'"050415150000000' | ||||
|   +'000000000000000000000001515150404",'#13#10'"0504151500000000000807070707070' | ||||
|   +'70000001515150404",'#13#10'"05041515000000000008070000070707000000151515040' | ||||
|   +'4",'#13#10'"050415150000000000080700000707070000001515150404",'#13#10'"0504' | ||||
|   +'15150000000000080707070707070000001515150404",'#13#10'"05041515070000000008' | ||||
|   +'0808080808080000071515150404",'#13#10'"050415151515151515151515151515151515' | ||||
|   +'151515150404",'#13#10'"050415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"050404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdLogStream','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505000000050' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040008040404040404040404040' | ||||
|   +'5",'#13#10'"050411111111111111110306061111111111111111110404",'#13#10'"0504' | ||||
|   +'11111111111111111106060611111111111111110404",'#13#10'"05040303030303030303' | ||||
|   +'0300061206030303030303030404",'#13#10'"050411111111110711111104060606081111' | ||||
|   +'111111110404",'#13#10'"050411111111110800110006040604071111111111110404",' | ||||
|   +#13#10'"050411111111111108000604060600111111111111110404",'#13#10'"050411111' | ||||
|   +'111110006060606040011111111111111110404",'#13#10'"0504111111110406061206060' | ||||
|   +'60011111111111111110404",'#13#10'"05041111110006060606061206081111111111111' | ||||
|   +'1110404",'#13#10'"050411111106060406120606060300111111111111110404",'#13#10 | ||||
|   +'"050411110004060406060606120011111111111111110404",'#13#10'"050411110603060' | ||||
|   +'400061207070011001108111111110404",'#13#10'"0504111106080606060604060600031' | ||||
|   +'50002031111110404",'#13#10'"05041111000604061206060606060608000011111111040' | ||||
|   +'4",'#13#10'"050411110006060406060604061206060000111111110404",'#13#10'"0504' | ||||
|   +'11111104060806060606060606060606000811110404",'#13#10'"05041111110006080006' | ||||
|   +'0406040006040612060611110404",'#13#10'"050411111111060002060408060604000606' | ||||
|   +'060611110404",'#13#10'"050411111111030606020006060604000604040611110404",' | ||||
|   +#13#10'"050411111111110302000008040606061206061111110404",'#13#10'"050404040' | ||||
|   +'404040404000606060604040608040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdUDPServer','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c none",' | ||||
|   +#13#10'"04 c #000080",'#13#10'"05 c #800080",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0303000000000000000303030303030' | ||||
|   +'30303030303030303",'#13#10'"03030015151515150004040404040404040404040404040' | ||||
|   +'3",'#13#10'"030400151414141500151515151515151515151515150404",'#13#10'"0304' | ||||
|   +'00151414141500151515151515151515151515150404",'#13#10'"03040015080808080008' | ||||
|   +'0808080808080808080815150404",'#13#10'"030400000000000000070707070707070707' | ||||
|   +'070815150404",'#13#10'"000000151507070700000007070707070707081515150404",' | ||||
|   +#13#10'"001515070707070707080008080808070708080808080404",'#13#10'"001508080' | ||||
|   +'808080808080015150807070707070707070404",'#13#10'"0000000000000000000000150' | ||||
|   +'80707070707070707070404",'#13#10'"03041515151515151515151508080808080808080' | ||||
|   +'8080404",'#13#10'"030415151515151515151515151515151515151515150404",'#13#10 | ||||
|   +'"030415151515151515151515151515151515151515150404",'#13#10'"030415000015150' | ||||
|   +'000150000000015150000000000150404",'#13#10'"0304150000151500001500001500001' | ||||
|   +'50000150000150404",'#13#10'"03041500001515000015000015000015000015000015040' | ||||
|   +'4",'#13#10'"030415000015150000150000150000150000000000150404",'#13#10'"0304' | ||||
|   +'15000015150000150000150000150000151515150404",'#13#10'"03041500001515000015' | ||||
|   +'0000150000150000151515150404",'#13#10'"030415150000000015150000000015150000' | ||||
|   +'151515150404",'#13#10'"030415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"030404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0303040404040404040404040' | ||||
|   +'40404040404040404040403"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdCmdTCPServer','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c none",' | ||||
|   +#13#10'"04 c #000080",'#13#10'"05 c #800080",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #808080",'#13#10'"08 c #C0C0C0",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0303030303030303030303030303030' | ||||
|   +'30303030303030303",'#13#10'"03030404040404040404040404040404040404040404040' | ||||
|   +'3",'#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"0304' | ||||
|   +'15151515151515151515151515151515151515150404",'#13#10'"03041515151515151515' | ||||
|   +'1515151515151515151515150404",'#13#10'"030415151515151515151515151515151515' | ||||
|   +'151515150404",'#13#10'"030415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"030415070000000015000008150800000000000007150404",'#13#10'"030400000' | ||||
|   +'815080015150007150700151500000800000404",'#13#10'"0304000015151515151500001' | ||||
|   +'50000151500001500000404",'#13#10'"03040000151515151515000707070015150000150' | ||||
|   +'0000404",'#13#10'"030400001515151515150008000800151500001500000404",'#13#10 | ||||
|   +'"030400000815080015150015071500151500000800000404",'#13#10'"030415070000000' | ||||
|   +'815000000150000000000000007150404",'#13#10'"0304151515151515151515151515151' | ||||
|   +'51515151515150404",'#13#10'"03041515151515151515151515151515151515151515040' | ||||
|   +'4",'#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"0304' | ||||
|   +'15151515151515151515151515151515151515150404",'#13#10'"03041515151515151515' | ||||
|   +'1515151515151515151515150404",'#13#10'"030415151515151515151515151515151515' | ||||
|   +'151515150404",'#13#10'"030415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"030404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0303040404040404040404040' | ||||
|   +'40404040404040404040403"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdSimpleServer','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505000000000000000505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050015151515150004040404040404040404040404040' | ||||
|   +'5",'#13#10'"050400151414141500151515151515151515151515150404",'#13#10'"0504' | ||||
|   +'00151414141500151515151515151515151515150404",'#13#10'"05040015080808080015' | ||||
|   +'1515151515151515151515150404",'#13#10'"050400000000000000151515151515151515' | ||||
|   +'151515150404",'#13#10'"000000151507070700000015151515151515151515150404",' | ||||
|   +#13#10'"001515070707070707080015151515151515151515150404",'#13#10'"001508080' | ||||
|   +'808080808080015151515151515151515150404",'#13#10'"0000000000000000000000151' | ||||
|   +'51515151515151515150404",'#13#10'"05041515151515151515151515151515151515151' | ||||
|   +'5150404",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10 | ||||
|   +'"050415151515151515151515151515151515151515150404",'#13#10'"050415000000000' | ||||
|   +'000150000000000150000000000150404",'#13#10'"0504151515000015151500001515151' | ||||
|   +'50000150000150404",'#13#10'"05041515150000151515000015151515000015000015040' | ||||
|   +'4",'#13#10'"050415151500001515150000151515150000000000150404",'#13#10'"0504' | ||||
|   +'15151500001515150000151515150000151515150404",'#13#10'"05041515150000151515' | ||||
|   +'0000151515150000151515150404",'#13#10'"050415151500001515150000000000150000' | ||||
|   +'151515150404",'#13#10'"050415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"050404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdTCPServer','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505000000000000000505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050015151515150004040404040404040404040404040' | ||||
|   +'5",'#13#10'"050400151414141500151515151515151515151515150404",'#13#10'"0504' | ||||
|   +'00151414141500151515151515151515151515150404",'#13#10'"05040015080808080003' | ||||
|   +'0303030303030303030315150404",'#13#10'"050400000000000000111111111111111111' | ||||
|   +'110315150404",'#13#10'"000000151507070700000011111111111111031515150404",' | ||||
|   +#13#10'"001515070707070707080003030303111103030303030404",'#13#10'"001508080' | ||||
|   +'808080808080015150311111111111111110404",'#13#10'"0000000000000000000000150' | ||||
|   +'31111111111111111110404",'#13#10'"05041515151515151515151503030303030303030' | ||||
|   +'3030404",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10 | ||||
|   +'"050415151515151515151515151515151515151515150404",'#13#10'"050415000000000' | ||||
|   +'000150000000000150000000000150404",'#13#10'"0504151515000015151500001515151' | ||||
|   +'50000150000150404",'#13#10'"05041515150000151515000015151515000015000015040' | ||||
|   +'4",'#13#10'"050415151500001515150000151515150000000000150404",'#13#10'"0504' | ||||
|   +'15151500001515150000151515150000151515150404",'#13#10'"05041515150000151515' | ||||
|   +'0000151515150000151515150404",'#13#10'"050415151500001515150000000000150000' | ||||
|   +'151515150404",'#13#10'"050415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"050404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdIPMCastServer','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505000000000000000505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050015151515150004040404040404040404040404040' | ||||
|   +'5",'#13#10'"050400151414141500080808080808151515151515150404",'#13#10'"0504' | ||||
|   +'00151414141500150708070707080715151515150404",'#13#10'"05040015080808080008' | ||||
|   +'0707070708070707151515150404",'#13#10'"050400000000000000070708080815080708' | ||||
|   +'151515150404",'#13#10'"000000151507070700000015070707150815081515150404",' | ||||
|   +#13#10'"001515070707070707080008080707080707081515150404",'#13#10'"001508080' | ||||
|   +'808080808080007070707080707081515150404",'#13#10'"0000000000000000000000080' | ||||
|   +'70815080708081515150404",'#13#10'"05041515150807070815070808150708070708151' | ||||
|   +'5150404",'#13#10'"050415151508150807081500001508150815081515150404",'#13#10 | ||||
|   +'"050415151507070707150800000715070708071515150404",'#13#10'"050415151515080' | ||||
|   +'708070800000708081508151515150404",'#13#10'"0504151515151508071500000008150' | ||||
|   +'70815151515150404",'#13#10'"05041515151515151507000808001507151515151515040' | ||||
|   +'4",'#13#10'"050415151515151515080000000015151515151515150404",'#13#10'"0504' | ||||
|   +'15151515151515000008070007151515151515150404",'#13#10'"05041515151515150700' | ||||
|   +'0700080008151515151515150404",'#13#10'"050415151515151507000800080008151515' | ||||
|   +'151515150404",'#13#10'"050415151515151508000808150000071515151515150404",' | ||||
|   +#13#10'"050415151515151500080800080800071515151515150404",'#13#10'"050404040' | ||||
|   +'404040700070800001500080404040404040404",'#13#10'"0505040404040407000808080' | ||||
|   +'70008080404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdSocksInfo','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c #800080",'#13#10'"06 c #008080",'#13 | ||||
|   +#10'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c none",'#13#10'"10 c ' | ||||
|   +'green",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13 | ||||
|   +#10'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0909090907080000000003080807' | ||||
|   +'09090909090909090909",'#13#10'"09090407000311111111110303030004040404040404' | ||||
|   +'0409",'#13#10'"090415070011111111111111110300081515151515150404",'#13#10'"0' | ||||
|   +'90415150003111111111111110300071515151515150404",'#13#10'"09041515000311031' | ||||
|   +'1030311110300151515151515150404",'#13#10'"090415150000000204020802000808151' | ||||
|   +'515151515150404",'#13#10'"090415150700081008100614020115151515151515150404"' | ||||
|   +','#13#10'"090415150700061410071008020815151515151515150404",'#13#10'"090415' | ||||
|   +'150700100808101408020415151515151515150404",'#13#10'"0904151507000810140810' | ||||
|   +'06020815151515151515150404",'#13#10'"09041515070014081006081004031515151515' | ||||
|   +'1515150404",'#13#10'"090415150800100810071008020815151515151515150404",'#13 | ||||
|   +#10'"090415150800061008101406020515151515151515150404",'#13#10'"090415150803' | ||||
|   +'030006081008100407151515151515150404",'#13#10'"0904151508001111000208100810' | ||||
|   +'08081515151515150404",'#13#10'"09041515000311110300061408061008020708151515' | ||||
|   +'0404",'#13#10'"090415150703111111000210081008060600000115150404",'#13#10'"0' | ||||
|   +'90415151500111103000806101408020303020007150404",'#13#10'"09041515151500110' | ||||
|   +'3000610070202031111030007150404",'#13#10'"090415151515070000020806100011111' | ||||
|   +'111110008150404",'#13#10'"090415151515150700061008060311111111030007150404"' | ||||
|   +','#13#10'"090415151515151515070800031111111111000815150404",'#13#10'"090404' | ||||
|   +'040404040404040407000303111101000704040404",'#13#10'"0909040404040404040404' | ||||
|   +'04040708000006040404040409"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdAntiFreeze','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c #800080",'#13#10'"06 c #008080",'#13 | ||||
|   +#10'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c none",'#13#10'"10 c ' | ||||
|   +'green",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13 | ||||
|   +#10'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0909090909090909090909090909' | ||||
|   +'09090909090909090909",'#13#10'"09090404040404000000040404040404040404040404' | ||||
|   +'0409",'#13#10'"090415151515150000001511111111111115151515150404",'#13#10'"0' | ||||
|   +'90415151515151111111115151515151111151515150404",'#13#10'"09041515151511111' | ||||
|   +'1111515151515151111151515150404",'#13#10'"090415151515111111111515151511111' | ||||
|   +'111111515150404",'#13#10'"090415151515111111111111111111111111111515150404"' | ||||
|   +','#13#10'"090415151511111111111111111111111111111515150404",'#13#10'"090415' | ||||
|   +'151511080101010101010101030103111515150404",'#13#10'"0904151515110800000000' | ||||
|   +'00000000000001111515150404",'#13#10'"09041515151108000000000000000000000111' | ||||
|   +'1515150404",'#13#10'"090415151511080000000000000000000003111515150404",'#13 | ||||
|   +#10'"090415151511080000000000000000000003111515150404",'#13#10'"090415151511' | ||||
|   +'080808080808080808080803111515150404",'#13#10'"0904151515110808080808080808' | ||||
|   +'08080003111515150404",'#13#10'"09041515151108080000000808080008000311151515' | ||||
|   +'0404",'#13#10'"090415151511080000000000000000000003111515150404",'#13#10'"0' | ||||
|   +'90415151511080000000000000000000003111515150404",'#13#10'"09041515151108000' | ||||
|   +'0000000000000000003111515150404",'#13#10'"090415151511080000000000000000000' | ||||
|   +'103111515150404",'#13#10'"090415151511110808080808080808070711111515150404"' | ||||
|   +','#13#10'"090415151511111111111111111111111111111515150404",'#13#10'"090404' | ||||
|   +'040404111111111111111111111111040404040404",'#13#10'"0909040404040404040404' | ||||
|   +'04040404040404040404040409"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdSchedulerOfThreadDefault','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c none",' | ||||
|   +#13#10'"04 c #000080",'#13#10'"05 c #800080",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0303030303030303030303030303030' | ||||
|   +'30303030303030303",'#13#10'"03030404040404040404040404040404040404040404040' | ||||
|   +'3",'#13#10'"030409141409141414141414141414141414091414090404",'#13#10'"0304' | ||||
|   +'14091409141414141414141414141414091409140404",'#13#10'"03041414091409141414' | ||||
|   +'1414141414141409140914140404",'#13#10'"030409091409140914141414141414140914' | ||||
|   +'091409090404",'#13#10'"030414140914091409141414141414091409140914140404",' | ||||
|   +#13#10'"030414140009000909000000000000090900090014140404",'#13#10'"030414140' | ||||
|   +'007090909090707070709090909070014140404",'#13#10'"0304141400070707090909070' | ||||
|   +'70909090707070014140404",'#13#10'"03041414000707070709090707090907070707001' | ||||
|   +'4140404",'#13#10'"030414140007070707070709090707070707070014140404",'#13#10 | ||||
|   +'"030414140007070707070709090707070707070014140404",'#13#10'"030414140007070' | ||||
|   +'707090907070909070707070014140404",'#13#10'"0304141400070707090909070709090' | ||||
|   +'90707070014140404",'#13#10'"03041414000709090909070707070909090907001414040' | ||||
|   +'4",'#13#10'"030414140009000909000000000000090900090014140404",'#13#10'"0304' | ||||
|   +'14140914091409141414141414091409140914140404",'#13#10'"03040909140914091414' | ||||
|   +'1414141414140914091409090404",'#13#10'"030414140914091414141414141414141409' | ||||
|   +'140914140404",'#13#10'"030414091409141414141414141414141414091409140404",' | ||||
|   +#13#10'"030409141409141414141414141414141414091414090404",'#13#10'"030404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0303040404040404040404040' | ||||
|   +'40404040404040404040403"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdSchedulerOfThreadPool','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c none",' | ||||
|   +#13#10'"04 c #000080",'#13#10'"05 c #800080",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0303030303030303030303030303030' | ||||
|   +'30303030303030303",'#13#10'"03030404040404040404040404040404040404040404040' | ||||
|   +'3",'#13#10'"030405050514141414141414141414141414140505050404",'#13#10'"0304' | ||||
|   +'14141405050505141414141414050505051414140404",'#13#10'"03041414141414141405' | ||||
|   +'0505050505141414141414140404",'#13#10'"030405050514141414141414141414141414' | ||||
|   +'140505050404",'#13#10'"030414141405050505141414141414050505051414140404",' | ||||
|   +#13#10'"030414140000000000050505050505000000000014140404",'#13#10'"030405050' | ||||
|   +'507070707070707070707070707070505050404",'#13#10'"0304141400050505050707070' | ||||
|   +'70707050505050014140404",'#13#10'"03041414000707070705050505050507070707001' | ||||
|   +'4140404",'#13#10'"030414140007070707070707070707070707070014140404",'#13#10 | ||||
|   +'"030414140007070707070707070707070707070014140404",'#13#10'"030414140007070' | ||||
|   +'707050505050505070707070014140404",'#13#10'"0304141400050505050707070707070' | ||||
|   +'50505050014140404",'#13#10'"03040505050707070707070707070707070707050505040' | ||||
|   +'4",'#13#10'"030414140000000000050505050505000000000014140404",'#13#10'"0304' | ||||
|   +'14141405050505141414141414050505051414140404",'#13#10'"03040505051414141414' | ||||
|   +'1414141414141414140505050404",'#13#10'"030414141414141414050505050505141414' | ||||
|   +'141414140404",'#13#10'"030414141405050505141414141414050505051414140404",' | ||||
|   +#13#10'"030405050514141414141414141414141414140505050404",'#13#10'"030404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0303040404040404040404040' | ||||
|   +'40404040404040404040403"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIdThreadComponent','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c #808000' | ||||
|   +'",'#13#10'"04 c #000080",'#13#10'"05 c none",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0505050505050505050505050505050' | ||||
|   +'50505050505050505",'#13#10'"05050404040404040404040404040404040404040404040' | ||||
|   +'5",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"0504' | ||||
|   +'15151515151515151515151515151515151515150404",'#13#10'"05041515151515151515' | ||||
|   +'1515151515151515151515150404",'#13#10'"050415151515151515151515151515151515' | ||||
|   +'151515150404",'#13#10'"050415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"050415151' | ||||
|   +'515151515151515151515151515151515150404",'#13#10'"1313131313131313131313131' | ||||
|   +'31313131313131313131313",'#13#10'"13131313131313131313131313131313131313131' | ||||
|   +'3131313",'#13#10'"131313131313131313131313131313131313131313131313",'#13#10 | ||||
|   +'"050415151515151515151515151515151515151515150404",'#13#10'"050415151515151' | ||||
|   +'515151515151515151515151515150404",'#13#10'"0504151515151515151515151515151' | ||||
|   +'51515151515150404",'#13#10'"05041515151515151515151515151515151515151515040' | ||||
|   +'4",'#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"0504' | ||||
|   +'15151515151515151515151515151515151515150404",'#13#10'"05041515151515151515' | ||||
|   +'1515151515151515151515150404",'#13#10'"050415151515151515151515151515151515' | ||||
|   +'151515150404",'#13#10'"050415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"050415151515151515151515151515151515151515150404",'#13#10'"050404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0505040404040404040404040' | ||||
|   +'40404040404040404040405"'#13#10'};'#13#10 | ||||
| ]); | ||||
| LazarusResources.Add('TIDICMPCLIENT','XPM',[ | ||||
|   '/* XPM */'#13#10'static char *Pixmap[] = {'#13#10'"24 24 16 2",'#13#10'"00 c' | ||||
|   +' black",'#13#10'"01 c #800000",'#13#10'"02 c #008000",'#13#10'"03 c none",' | ||||
|   +#13#10'"04 c #000080",'#13#10'"05 c #800080",'#13#10'"06 c #008080",'#13#10 | ||||
|   +'"07 c #C0C0C0",'#13#10'"08 c #808080",'#13#10'"09 c red",'#13#10'"10 c gree' | ||||
|   +'n",'#13#10'"11 c yellow",'#13#10'"12 c blue",'#13#10'"13 c magenta",'#13#10 | ||||
|   +'"14 c cyan",'#13#10'"15 c Gray100",'#13#10'"0303030303030303030303030303030' | ||||
|   +'30303030303030303",'#13#10'"03030404040404040404040404040404040404040404040' | ||||
|   +'3",'#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"0304' | ||||
|   +'05050505050505050505050505050515151515150404",'#13#10'"03041313131313131313' | ||||
|   +'1313131313130515151515150404",'#13#10'"030413131313131313131313131313051515' | ||||
|   +'151515150404",'#13#10'"030405050505050505050513131305151515151515150404",' | ||||
|   +#13#10'"030415151515151515051313130505050505050505050404",'#13#10'"030415151' | ||||
|   +'515151505131313131313131313131313130404",'#13#10'"0304151515151505131313131' | ||||
|   +'31313131313131313130404",'#13#10'"03041515151515050505050505050505050505050' | ||||
|   +'5050404",'#13#10'"030415151515151515151515151515151515151515150404",'#13#10 | ||||
|   +'"030415151515151515151515151515151515151515150404",'#13#10'"030415000015000' | ||||
|   +'000001500001500001500000000150404",'#13#10'"0304150000150000151515000000000' | ||||
|   +'01500001500150404",'#13#10'"03041500001500001515150015001500150000150015040' | ||||
|   +'4",'#13#10'"030415000015000015151500150015001500000000150404",'#13#10'"0304' | ||||
|   +'15000015000015151500150015001500001515150404",'#13#10'"03041500001500001515' | ||||
|   +'1500150015001500001515150404",'#13#10'"030415000015000000001500150015001500' | ||||
|   +'001515150404",'#13#10'"030415151515151515151515151515151515151515150404",' | ||||
|   +#13#10'"030415151515151515151515151515151515151515150404",'#13#10'"030404040' | ||||
|   +'404040404040404040404040404040404040404",'#13#10'"0303040404040404040404040' | ||||
|   +'40404040404040404040403"'#13#10'};'#13#10 | ||||
| ]); | ||||
							
								
								
									
										668
									
								
								indy/Core/IdRegisterCore.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,668 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.1    2/8/2004 1:35:40 PM  JPMugaas | ||||
|   IdSocks is now in DotNET. | ||||
| 
 | ||||
|   Rev 1.0    2/3/2004 12:28:06 PM  JPMugaas | ||||
|   Kudzu wanted this renamed. | ||||
| 
 | ||||
|   Rev 1.27    2004.01.01 2:40:02 PM  czhower | ||||
|   Removed test ifdef | ||||
| 
 | ||||
|   Rev 1.26    1/1/2004 3:32:30 PM  BGooijen | ||||
|   Added icons for .Net | ||||
| 
 | ||||
|   Rev 1.25    2003.12.31 11:02:50 PM  czhower | ||||
|   New components now registered for .net. | ||||
| 
 | ||||
|   Rev 1.24    2003.12.25 6:55:20 PM  czhower | ||||
|   TCPServer | ||||
| 
 | ||||
|   Rev 1.23    11/22/2003 11:49:52 PM  BGooijen | ||||
|   Icons for DotNet | ||||
| 
 | ||||
|   Rev 1.22    17/11/2003 16:00:22  ANeillans | ||||
|   Fix Delphi compile errors. | ||||
| 
 | ||||
|   Rev 1.21    11/8/2003 8:09:24 PM  BGooijen | ||||
|   fix, i mixed up some stuff | ||||
| 
 | ||||
|   Rev 1.20    11/8/2003 7:27:10 PM  BGooijen | ||||
|   DotNet | ||||
| 
 | ||||
|   Rev 1.19    2003.10.19 1:35:32 PM  czhower | ||||
|   Moved Borland define to .inc | ||||
| 
 | ||||
|   Rev 1.18    2003.10.18 11:32:42 PM  czhower | ||||
|   Changed throttler to intercept | ||||
| 
 | ||||
|   Rev 1.17    2003.10.17 6:18:50 PM  czhower | ||||
|   TIdInterceptSimLog | ||||
| 
 | ||||
|   Rev 1.16    2003.10.14 1:26:42 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.15    9/21/2003 01:10:40 AM  JPMugaas | ||||
|   Added IdThreadCOmponent to the registration in Core. | ||||
| 
 | ||||
|   Rev 1.14    2003.08.19 11:06:34 PM  czhower | ||||
|   Fixed names of scheduler units. | ||||
| 
 | ||||
|   Rev 1.13    8/19/2003 01:25:08 AM  JPMugaas | ||||
|   Unnecessary junk removed. | ||||
| 
 | ||||
|   Rev 1.12    8/15/2003 12:02:48 AM  JPMugaas | ||||
|   Incremented version number. | ||||
|   Moved some units to new IndySuperCore package in D7. | ||||
|   Made sure package titles are uniform in the IDE and in the .RES files. | ||||
| 
 | ||||
|   Rev 1.11    7/24/2003 03:22:00 AM  JPMugaas | ||||
|   Removed some old files. | ||||
| 
 | ||||
|   Rev 1.10    7/18/2003 4:33:12 PM  SPerry | ||||
|   Added TIdCmdTCPClient | ||||
| 
 | ||||
|   Rev 1.7    4/17/2003 05:02:26 PM  JPMugaas | ||||
| 
 | ||||
|   Rev 1.6    4/11/2003 01:09:50 PM  JPMugaas | ||||
| 
 | ||||
|   Rev 1.5    3/25/2003 11:12:54 PM  BGooijen | ||||
|   TIdChainEngineStack added. | ||||
| 
 | ||||
|   Rev 1.4    3/25/2003 05:02:00 PM  JPMugaas | ||||
|   TCmdTCPServer added. | ||||
| 
 | ||||
|   Rev 1.3    3/22/2003 10:14:54 PM  BGooijen | ||||
|   Added TIdServerIOHandlerChain to the palette | ||||
| 
 | ||||
|   Rev 1.2    3/22/2003 02:20:48 PM  JPMugaas | ||||
|   Updated registration. | ||||
| 
 | ||||
|   Rev 1.1    1/17/2003 04:18:44 PM  JPMugaas | ||||
|   Now compiles with new packages. | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:41:42 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdRegisterCore; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| uses | ||||
|   Classes; | ||||
| 
 | ||||
| // Procedures | ||||
| 
 | ||||
|   procedure Register; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF FMX} | ||||
|   Controls, | ||||
|   {$ENDIF} | ||||
|   {$IFDEF FPC} | ||||
|   LResources, | ||||
|   {$ENDIF} | ||||
|   IdSocks, | ||||
|   {$IFDEF HAS_TSelectionEditor} | ||||
|     {$IFDEF FPC} | ||||
|   PropEdits, | ||||
|   ComponentEditors, | ||||
|     {$ELSE} | ||||
|   DesignIntf, | ||||
|   DesignEditors, | ||||
|     {$ENDIF} | ||||
|   TypInfo, | ||||
|     {$IFDEF VCL_2010_OR_ABOVE} | ||||
|   Rtti, | ||||
|     {$ENDIF} | ||||
|   SysUtils, | ||||
|   IdGlobal, | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   IdBaseComponent, | ||||
|   IdComponent, | ||||
|   IdDsnCoreResourceStrings, | ||||
|   IdAntiFreeze, | ||||
|   IdCmdTCPClient, | ||||
|   IdCmdTCPServer, | ||||
|   IdIOHandlerStream, | ||||
|   {$IFNDEF DOTNET} | ||||
|   IdIcmpClient, | ||||
|   {$ENDIF} | ||||
|   IdInterceptSimLog, | ||||
|   IdInterceptThrottler, | ||||
|   IdIPMCastClient, | ||||
|   IdIPMCastServer, | ||||
|   IdLogDebug, | ||||
|   IdLogEvent, | ||||
|   IdLogFile, | ||||
|   IdLogStream, | ||||
|   IdSchedulerOfThread, | ||||
|   IdSchedulerOfThreadDefault, | ||||
|   IdSchedulerOfThreadPool, | ||||
|   IdServerIOHandlerSocket, | ||||
|   IdServerIOHandlerStack, | ||||
|   IdSimpleServer, | ||||
|   IdThreadComponent, | ||||
|   {$IFNDEF DOTNET} | ||||
|   IdTraceRoute, | ||||
|   {$ENDIF} | ||||
|   IdUDPClient, | ||||
|   IdUDPServer, | ||||
|   IdIOHandlerSocket, | ||||
|   IdIOHandlerStack, | ||||
|   IdIntercept, | ||||
|   IdTCPServer, | ||||
|   IdTCPClient; | ||||
| 
 | ||||
| {$IFDEF DOTNET} | ||||
|   {$R IconsDotNet\TIdAntiFreeze.bmp} | ||||
|   {$R IconsDotNet\TIdCmdTCPClient.bmp} | ||||
|   {$R IconsDotNet\TIdCmdTCPServer.bmp} | ||||
|   {$R IconsDotNet\TIdConnectionIntercept.bmp} | ||||
|   {$R IconsDotNet\TIdICMPClient.bmp} | ||||
|   {$R IconsDotNet\TIdInterceptSimLog.bmp} | ||||
|   {$R IconsDotNet\TIdInterceptThrottler.bmp} | ||||
|   {$R IconsDotNet\TIdIOHandlerStack.bmp} | ||||
|   {$R IconsDotNet\TIdIOHandlerStream.bmp} | ||||
|   {$R IconsDotNet\TIdLogDebug.bmp} | ||||
|   {$R IconsDotNet\TIdLogEvent.bmp} | ||||
|   {$R IconsDotNet\TIdLogFile.bmp} | ||||
|   {$R IconsDotNet\TIdLogStream.bmp} | ||||
|   {$R IconsDotNet\TIdSchedulerOfThreadDefault.bmp} | ||||
|   {$R IconsDotNet\TIdSchedulerOfThreadPool.bmp} | ||||
|   {$R IconsDotNet\TIdServerIOHandlerStack.bmp} | ||||
|   {$R IconsDotNet\TIdSimpleServer.bmp} | ||||
|   {$R IconsDotNet\TIdTCPClient.bmp} | ||||
|   {$R IconsDotNet\TIdTCPServer.bmp} | ||||
|   {$R IconsDotNet\TIdThreadComponent.bmp} | ||||
|   {$R IconsDotNet\TIdUDPClient.bmp} | ||||
|   {$R IconsDotNet\TIdUDPServer.bmp} | ||||
|   {$R IconsDotNet\TIdIPMCastClient.bmp} | ||||
|   {$R IconsDotNet\TIdIPMCastServer.bmp} | ||||
|   {$R IconsDotNet\TIdSocksInfo.bmp} | ||||
| {$ELSE} | ||||
|   {$IFNDEF FPC} | ||||
|     {$IFDEF BORLAND} | ||||
|       {$R IdCoreRegister.dcr} | ||||
|     {$ELSE} | ||||
|       {$R IdCoreRegisterCool.dcr} | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
| {$ENDIF} | ||||
| 
 | ||||
| {$IFDEF HAS_TSelectionEditor} | ||||
| 
 | ||||
| // TIdComponentSelectionEditor is called at design-time when saving/compiling a | ||||
| // project.  It enumerates the data types of all parameters and return values of | ||||
| // every event handler assigned to any Indy component, extracting the unit names | ||||
| // of those data types and passing them to the IDE so it can insert them into | ||||
| // 'uses' clauses as needed. | ||||
| 
 | ||||
| procedure SendUnitNameToProc(const AUnitName: String; Proc: TGetStrProc); | ||||
| begin | ||||
|   // Do not return the 'System' unit, otherwise it will | ||||
|   // cause an "Identifier redeclared" compiler error! | ||||
|   if (AUnitName <> '') and (not TextIsSame(AUnitName, 'System')) then begin {do not localize} | ||||
|     Proc(AUnitName); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| {$IFDEF VCL_XE2_OR_ABOVE} | ||||
| 
 | ||||
| // in Delphi XE2 and later, TRttiInvokableType is used to enumerate parameters | ||||
| // and return values, and TRttiType reports fully qualified type names, so | ||||
| // finding a given type's unit name is very easy... | ||||
| 
 | ||||
| function GetUnitNameForType(const AType: TRttiType): String; | ||||
| begin | ||||
|   // TRttiType.UnitName returns the unit that declares TRttiType itself | ||||
|   // (System.Rtti), so parse the TRttiType.QualifiedName value instead... | ||||
|   if AType <> nil then begin | ||||
|     Result := AType.QualifiedName; | ||||
|     SetLength(Result, Length(Result) - Length(AType.Name) - 1); | ||||
|   end else begin | ||||
|     Result := ''; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| {$ELSE} | ||||
| 
 | ||||
| // in Delphi prior to XE2, as well as in FreePascal, TRttiInvokableType is not | ||||
| // available, so we have to use TypInfo RTTI to enumerating parameters and | ||||
| // return values, but only certain versions implement rich enough RTTI to allow | ||||
| // that. Let's try to pull out what we can... | ||||
| 
 | ||||
| {$IFDEF FPC_2_6_0_OR_ABOVE} | ||||
|   {$DEFINE HAS_tkEnumeration_UnitName} | ||||
|   {$DEFINE HAS_tkMethod_ParamTypeInfo} | ||||
| {$ELSE} | ||||
|   {$IFDEF VCL_6_OR_ABOVE} | ||||
|     {$DEFINE HAS_tkEnumeration_UnitName} | ||||
|   {$ENDIF} | ||||
|   {$IFDEF VCL_2010_OR_ABOVE} | ||||
|     {$DEFINE HAS_tkMethod_ParamTypeInfo} | ||||
|   {$ENDIF} | ||||
| {$ENDIF} | ||||
| 
 | ||||
| procedure SkipShortString(var P: PByte); | ||||
| begin | ||||
|   Inc(P, 1 + Integer(P^)); | ||||
| end; | ||||
| 
 | ||||
| function ReadShortString(var P: PByte): String; | ||||
| begin | ||||
|   {$IFDEF VCL_2009_OR_ABOVE} | ||||
|   Result := UTF8ToString(PShortString(P)^); | ||||
|   {$ELSE} | ||||
|   Result := PShortString(P)^; | ||||
|   {$ENDIF} | ||||
|   SkipShortString(P); | ||||
| end; | ||||
| 
 | ||||
| {$IFDEF FPC_2_6_0_OR_ABOVE} | ||||
| function NextShortString(PS: PShortString): PShortString; | ||||
| begin | ||||
|   Result := PShortString(Pointer(PS)+PByte(PS)^+1); | ||||
| end; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| function GetUnitNameFromTypeName(const ATypeName: String): String; | ||||
| var | ||||
|   K: Integer; | ||||
| begin | ||||
|   // check if the type is qualified | ||||
|   K := LastDelimiter('.', ATypeName); | ||||
|   if K <> 0 then begin | ||||
|     Result := Copy(ATypeName, 1, K-1); | ||||
|   end else begin | ||||
|     // TODO: enumerate package units and find the typename... | ||||
|     Result := ''; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function GetUnitNameFromTypeInfo(const ATypeInfo: PPTypeInfo): String; | ||||
| var | ||||
|   LTypeData: PTypeData; | ||||
|   {$IFDEF HAS_tkEnumeration_UnitName} | ||||
|     {$IFDEF FPC} | ||||
|   PS, PSLast: PShortString; | ||||
|     {$ELSE} | ||||
|   LBaseTypeData: PTypeData; | ||||
|   Value: Integer; | ||||
|   P: PByte; | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
| begin | ||||
|   Result := ''; | ||||
|   if ATypeInfo = nil then begin | ||||
|     Exit; | ||||
|   end; | ||||
|   if ATypeInfo^ = nil then begin | ||||
|     Exit; | ||||
|   end; | ||||
|   LTypeData := GetTypeData(ATypeInfo^); | ||||
|   case ATypeInfo^.Kind of | ||||
|     {$IFDEF HAS_tkEnumeration_UnitName} | ||||
|     tkEnumeration: begin | ||||
|       {$IFDEF FPC} | ||||
|       // the unit name iss the last string in the name list | ||||
|       PS := @(LTypeData^.NameList); | ||||
|       PSLast := nil; | ||||
|       while PByte(PS)^ <> 0 do begin | ||||
|         PSLast := PS; | ||||
|         PS := NextShortString(PS); | ||||
|       end; | ||||
|       if PSLast <> nil then begin | ||||
|         Result := PSLast^; | ||||
|       end; | ||||
|       {$ELSE} | ||||
|       // the unit name follows after the name list | ||||
|       LBaseTypeData := GetTypeData(LTypeData^.BaseType^); | ||||
|       P := PByte(@(LBaseTypeData^.NameList)); | ||||
|       // LongBool/WordBool/ByteBool have MinValue < 0 and arbitrary | ||||
|       // content in Value; Boolean has Value in [0, 1] } | ||||
|       if (ATypeInfo^ = System.TypeInfo(Boolean)) or (LBaseTypeData^.MinValue < 0) then | ||||
|       begin | ||||
|         for Value := 0 to 1 do begin | ||||
|           SkipShortString(P); | ||||
|         end; | ||||
|       end else | ||||
|       begin | ||||
|         for Value := LBaseTypeData^.MinValue to LBaseTypeData^.MaxValue do begin | ||||
|           SkipShortString(P); | ||||
|         end; | ||||
|       end; | ||||
|       Result := ReadShortString(P); | ||||
|       {$ENDIF} | ||||
|     end; | ||||
|     {$ENDIF} | ||||
|     tkSet: begin | ||||
|       Result := GetUnitNameFromTypeInfo(LTypeData^.CompType); | ||||
|     end; | ||||
|     {$IFDEF VCL_5_OR_ABOVE} | ||||
|     tkClass: begin | ||||
|         {$IFDEF VCL_2009_OR_ABOVE} | ||||
|       Result := UTF8ToString(LTypeData^.UnitName); | ||||
|         {$ELSE} | ||||
|       Result := LTypeData^.UnitName; | ||||
|         {$ENDIF} | ||||
|     end; | ||||
|     {$ENDIF} | ||||
|     {$IFDEF FPC_2_6_0_OR_ABOVE} | ||||
|     tkHelper: begin | ||||
|       Result := LTypeData^.HelperUnit; | ||||
|     end; | ||||
|     {$ENDIF} | ||||
|     {$IFDEF VCL_5_OR_ABOVE} | ||||
|     tkInterface: begin | ||||
|         {$IFDEF VCL_2009_OR_ABOVE} | ||||
|       Result := UTF8ToString(LTypeData^.IntfUnit); | ||||
|         {$ELSE} | ||||
|       Result := LTypeData^.IntfUnit; | ||||
|         {$ENDIF} | ||||
|     end; | ||||
|     {$ENDIF} | ||||
|     {$IFDEF FPC_2_2_2_OR_ABOVE} // TODO: when was tkInterfaceRaw added? | ||||
|     tkInterfaceRaw: begin | ||||
|       Result := LTypeData^.RawIntfUnit; | ||||
|     end; | ||||
|     {$ENDIF} | ||||
|     {$IFDEF VCL_6_OR_ABOVE} | ||||
|     tkDynArray: begin | ||||
|         {$IFDEF VCL_2009_OR_ABOVE} | ||||
|       Result := UTF8ToString(LTypeData^.DynUnitName); | ||||
|         {$ELSE} | ||||
|       Result := LTypeData^.DynUnitName; | ||||
|         {$ENDIF} | ||||
|       if Result = '' then begin | ||||
|         Result := GetUnitNameFromTypeInfo(LTypeData^.elType2); | ||||
|       end; | ||||
|     end; | ||||
|     {$ENDIF} | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure GetUnitNamesForMethodType(const ATypeInfo: PTypeInfo; Proc: TGetStrProc); | ||||
| type | ||||
|   PPPTypeInfo = ^PPTypeInfo; | ||||
| var | ||||
|   LTypeData: PTypeData; | ||||
|   LTypeDataPtr: PByte; | ||||
|   K: Integer; | ||||
|   UnitName: string; | ||||
| begin | ||||
|   if ATypeInfo = nil then begin | ||||
|     Exit; | ||||
|   end; | ||||
|   LTypeData := GetTypeData(ATypeInfo); | ||||
|   LTypeDataPtr := PByte(@(LTypeData^.ParamList)); | ||||
| 
 | ||||
|   if LTypeData^.ParamCount > 0 then | ||||
|   begin | ||||
|     for K := 0 to LTypeData^.ParamCount-1 do | ||||
|     begin | ||||
|       Inc(LTypeDataPtr, SizeOf(TParamFlags)); | ||||
|       SkipShortString(LTypeDataPtr); | ||||
|       {$IFDEF HAS_tkMethod_ParamTypeInfo} | ||||
|       // handled further below... | ||||
|       SkipShortString(LTypeDataPtr); | ||||
|       {$ELSE} | ||||
|       UnitName := GetUnitNameFromTypeName(ReadShortString(LTypeDataPtr)); | ||||
|       SendUnitNameToProc(UnitName, Proc); | ||||
|       {$ENDIF} | ||||
|     end; | ||||
|   end; | ||||
| 
 | ||||
|   if LTypeData^.MethodKind = mkFunction then | ||||
|   begin | ||||
|     {$IFDEF HAS_tkMethod_ParamTypeInfo} | ||||
|     SkipShortString(LTypeDataPtr); | ||||
|     UnitName := GetUnitNameFromTypeInfo(PPPTypeInfo(LTypeDataPtr)^); | ||||
|     Inc(LTypeDataPtr, SizeOf(PPTypeInfo)); | ||||
|     {$ELSE} | ||||
|     UnitName := GetUnitNameFromTypeName(ReadShortString(LTypeDataPtr)); | ||||
|     {$ENDIF} | ||||
|     SendUnitNameToProc(UnitName, Proc); | ||||
|   end; | ||||
| 
 | ||||
|   {$IFDEF HAS_tkMethod_ParamTypeInfo} | ||||
|   if LTypeData^.ParamCount > 0 then | ||||
|   begin | ||||
|     Inc(LTypeDataPtr, SizeOf(TCallConv)); | ||||
|     for K := 0 to LTypeData^.ParamCount-1 do | ||||
|     begin | ||||
|       UnitName := GetUnitNameFromTypeInfo(PPPTypeInfo(LTypeDataPtr)^); | ||||
|       SendUnitNameToProc(UnitName, Proc); | ||||
|       Inc(LTypeDataPtr, SizeOf(PPTypeInfo)); | ||||
|     end; | ||||
|   end; | ||||
|   {$ENDIF} | ||||
| end; | ||||
| 
 | ||||
| {$ENDIF} | ||||
| 
 | ||||
| type | ||||
|   TIdBaseComponentSelectionEditor = class(TSelectionEditor) | ||||
|   public | ||||
|     procedure RequiresUnits(Proc: TGetStrProc); override; | ||||
|   end; | ||||
| 
 | ||||
| procedure TIdBaseComponentSelectionEditor.RequiresUnits(Proc: TGetStrProc); | ||||
| var | ||||
|   Comp: TIdBaseComponent; | ||||
|   I: Integer; | ||||
|   {$IFDEF VCL_2010_OR_ABOVE} | ||||
|   Ctx: TRttiContext; | ||||
|   PropInfo: TRttiProperty; | ||||
|   PropValue: TValue; | ||||
|     {$IFDEF VCL_XE2_OR_ABOVE} | ||||
|   PropType: TRttiMethodType; | ||||
|   Param: TRttiParameter; | ||||
|     {$ENDIF} | ||||
|   {$ELSE} | ||||
|   PropList: PPropList; | ||||
|   PropCount: Integer; | ||||
|   PropInfo: PPropInfo; | ||||
|   J: Integer; | ||||
|   {$ENDIF} | ||||
| begin | ||||
|   inherited RequiresUnits(Proc); | ||||
|   if (Designer = nil) or (Designer.Root = nil) then Exit; | ||||
| 
 | ||||
|   for I := 0 to Designer.Root.ComponentCount - 1 do | ||||
|   begin | ||||
|     if Designer.Root.Components[i] is TIdBaseComponent then | ||||
|     begin | ||||
|       Comp := TIdBaseComponent(Designer.Root.Components[i]); | ||||
| 
 | ||||
|       {$IFDEF VCL_2010_OR_ABOVE} | ||||
| 
 | ||||
|       Ctx := TRttiContext.Create; | ||||
|       for PropInfo in Ctx.GetType(Comp.ClassType).GetProperties do | ||||
|       begin | ||||
|         // only interested in *assigned* event handlers | ||||
| 
 | ||||
|         // NOTE: Delphi 2010 has a problem with checking the TValue.IsEmpty | ||||
|         // property inlined like below. It causes a "F2084 Internal Error C13394" | ||||
|         // compiler error. So splitting up the comparison to use a local TValue | ||||
|         // variable to work around that... | ||||
|         { | ||||
|         if (PropInfo.PropertyType.TypeKind = tkMethod) and | ||||
|            (not PropInfo.GetValue(Comp).IsEmpty) then | ||||
|         } | ||||
|         if PropInfo.PropertyType.TypeKind = tkMethod then | ||||
|         begin | ||||
|           PropValue := PropInfo.GetValue(Comp); | ||||
|           if not PropValue.IsEmpty then | ||||
|           begin | ||||
|             // although the System.Rtti unit was introduced in Delphi 2010, | ||||
|             // the TRttiInvokableType class was not added to it until XE2 | ||||
|             {$IFDEF VCL_XE2_OR_ABOVE} | ||||
|             PropType := PropInfo.PropertyType as TRttiMethodType; | ||||
|             for Param in PropType.GetParameters do begin | ||||
|               SendUnitNameToProc(GetUnitNameForType(Param.ParamType), Proc); | ||||
|             end; | ||||
|             SendUnitNameToProc(GetUnitNameForType(PropType.ReturnType), Proc); | ||||
|             {$ELSE} | ||||
|             // use the System.TypInfo unit to access the parameters and return type | ||||
|             GetUnitNamesForMethodType(PropInfo.PropertyType.Handle, Proc); | ||||
|             {$ENDIF} | ||||
|           end; | ||||
|         end; | ||||
|       end; | ||||
| 
 | ||||
|       {$ELSE} | ||||
| 
 | ||||
|       PropCount := GetPropList(Comp, PropList); | ||||
|       if PropCount > 0 then | ||||
|       begin | ||||
|         try | ||||
|           for J := 0 to PropCount-1 do | ||||
|           begin | ||||
|             PropInfo := PropList^[J]; | ||||
|             // only interested in *assigned* event handlers | ||||
|             if (PropInfo^.PropType^.Kind = tkMethod) and | ||||
|                (GetMethodProp(Comp, PropInfo).Code <> nil) then | ||||
|             begin | ||||
|               GetUnitNamesForMethodType(PropInfo^.PropType^, Proc); | ||||
|             end; | ||||
|           end; | ||||
|         finally | ||||
|           FreeMem(PropList); | ||||
|         end; | ||||
|       end; | ||||
| 
 | ||||
|       {$ENDIF} | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| {$ENDIF} | ||||
| 
 | ||||
| procedure Register; | ||||
| begin | ||||
|   {$IFNDEF FPC} | ||||
|   RegisterComponents(RSRegIndyClients, [ | ||||
|    TIdTCPClient | ||||
|    ,TIdUDPClient | ||||
|    ,TIdCmdTCPClient | ||||
|    ,TIdIPMCastClient | ||||
|    {$IFNDEF DOTNET} | ||||
|    ,TIdIcmpClient | ||||
|    ,TIdTraceRoute | ||||
|    {$ENDIF} | ||||
|   ]); | ||||
|   RegisterComponents(RSRegIndyServers, [ | ||||
|    TIdUDPServer, | ||||
|    TIdCmdTCPServer, | ||||
|    TIdSimpleServer, | ||||
|    TIdTCPServer, | ||||
|    TIdIPMCastServer | ||||
|   ]); | ||||
|   RegisterComponents(RSRegIndyIOHandlers,[ | ||||
|    TIdIOHandlerStack | ||||
|    ,TIdIOHandlerStream | ||||
|    ,TIdServerIOHandlerStack | ||||
|   ]); | ||||
|   RegisterComponents(RSRegIndyIntercepts, [ | ||||
|    TIdConnectionIntercept | ||||
|    ,TIdInterceptSimLog | ||||
|    ,TIdInterceptThrottler | ||||
|    ,TIdLogDebug | ||||
|    ,TIdLogEvent | ||||
|    ,TIdLogFile | ||||
|    ,TIdLogStream | ||||
|   ]); | ||||
| 
 | ||||
|   {$IFDEF FMX} | ||||
|   // RLebeau 8/1/2011 - FireMonkey has problems resolving references to | ||||
|   // TIdAntiFreeze correctly because it is implemented in a design-time | ||||
|   // package and not a run-time package.  Until we can fix that properly, | ||||
|   // we'll group TIdAntiFreeze with TControl so the IDE can filter out | ||||
|   // TIdAntiFreeze from appearing at design-time in FireMoney projects. | ||||
|   // Users will have to instantiate TIdAntiFreeze in code. This does not | ||||
|   // affect VCL projects. | ||||
|   GroupDescendentsWith(TIdAntiFreeze, TControl); | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   RegisterComponents(RSRegIndyMisc, [ | ||||
|    TIdSocksInfo, | ||||
|    TIdAntiFreeze, | ||||
|    TIdSchedulerOfThreadDefault, | ||||
|    TIdSchedulerOfThreadPool, | ||||
|    TIdThreadComponent | ||||
|   ]); | ||||
|   {$ELSE} | ||||
|   //This is a tempoary workaround for components not fitting on the palette | ||||
|   //in Lazarus.  Unlike Delphi, Lazarus still does not have the ability to | ||||
|   //scroll through a palette page. | ||||
|   RegisterComponents(RSRegIndyClients+CoreSuffix, [ | ||||
|    TIdTCPClient | ||||
|    ,TIdUDPClient | ||||
|    ,TIdCmdTCPClient | ||||
|    ,TIdIPMCastClient | ||||
|    {$IFNDEF DOTNET} | ||||
|    ,TIdIcmpClient | ||||
|    ,TIdTraceRoute | ||||
|    {$ENDIF} | ||||
|   ]); | ||||
|   RegisterComponents(RSRegIndyServers+CoreSuffix, [ | ||||
|    TIdUDPServer, | ||||
|    TIdCmdTCPServer, | ||||
|    TIdSimpleServer, | ||||
|    TIdTCPServer, | ||||
|    TIdIPMCastServer | ||||
|   ]); | ||||
|   RegisterComponents(RSRegIndyIOHandlers+CoreSuffix,[ | ||||
|    TIdIOHandlerStack | ||||
|    ,TIdIOHandlerStream | ||||
|    ,TIdServerIOHandlerStack | ||||
|   ]); | ||||
|   RegisterComponents(RSRegIndyIntercepts+CoreSuffix, [ | ||||
|    TIdConnectionIntercept | ||||
|    ,TIdInterceptSimLog | ||||
|    ,TIdInterceptThrottler | ||||
|    ,TIdLogDebug | ||||
|    ,TIdLogEvent | ||||
|    ,TIdLogFile | ||||
|    ,TIdLogStream | ||||
|   ]); | ||||
|   RegisterComponents(RSRegIndyMisc+CoreSuffix, [ | ||||
|    TIdSocksInfo, | ||||
|    TIdAntiFreeze, | ||||
|    TIdSchedulerOfThreadDefault, | ||||
|    TIdSchedulerOfThreadPool, | ||||
|    TIdThreadComponent | ||||
|   ]); | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   {$IFDEF HAS_TSelectionEditor} | ||||
|   RegisterSelectionEditor(TIdBaseComponent, TIdBaseComponentSelectionEditor); | ||||
|   {$ENDIF} | ||||
| end; | ||||
| 
 | ||||
| {$IFDEF FPC} | ||||
| initialization | ||||
| {$i IdRegisterCore.lrs} | ||||
| {$ENDIF} | ||||
| end. | ||||
							
								
								
									
										409
									
								
								indy/Core/IdReply.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,409 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.27    2/3/05 12:16:46 AM  RLebeau | ||||
|   Bug fix for UpdateText() | ||||
| 
 | ||||
|   Rev 1.25    1/15/2005 6:02:02 PM  JPMugaas | ||||
|   These should compile again. | ||||
| 
 | ||||
|   Rev 1.24    1/15/05 2:03:20 PM  RLebeau | ||||
|   Added AIgnore parameter to TIdReplies.Find() | ||||
| 
 | ||||
|   Updated TIdReply.SetNumericCode() to call SetCode() rather than assigning the | ||||
|   FCode member directly. | ||||
| 
 | ||||
|   Updated TIdReply.SetCode() to call Clear() before assigning the FCode member. | ||||
| 
 | ||||
|   Updated TIdReplies.UpdateText() to ignore the TIdReply that was passed in | ||||
|   when looking for a TIdReply to extract Text from. | ||||
| 
 | ||||
|   Rev 1.23    12/29/04 1:36:44 PM  RLebeau | ||||
|   Bug fix for when descendant constructors are called twice during creation | ||||
| 
 | ||||
|   Rev 1.22    10/26/2004 8:43:00 PM  JPMugaas | ||||
|   Should be more portable with new references to TIdStrings and TIdStringList. | ||||
| 
 | ||||
|   Rev 1.21    6/11/2004 8:48:24 AM  DSiders | ||||
|   Added "Do not Localize" comments. | ||||
| 
 | ||||
|   Rev 1.20    2004.03.01 7:10:34 PM  czhower | ||||
|   Change for .net compat | ||||
| 
 | ||||
|   Rev 1.19    2004.03.01 5:12:34 PM  czhower | ||||
|   -Bug fix for shutdown of servers when connections still existed (AV) | ||||
|   -Implicit HELP support in CMDserver | ||||
|   -Several command handler bugs | ||||
|   -Additional command handler functionality. | ||||
| 
 | ||||
|   Rev 1.18    2004.02.29 8:16:54 PM  czhower | ||||
|   Bug fix to fix AV at design time when adding reply texts to CmdTCPServer. | ||||
| 
 | ||||
|   Rev 1.17    2004.02.03 4:17:10 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.16    2004.01.29 12:02:32 AM  czhower | ||||
|   .Net constructor problem fix. | ||||
| 
 | ||||
|   Rev 1.15    1/3/2004 8:06:20 PM  JPMugaas | ||||
|   Bug fix:  Sometimes, replies will appear twice due to the way functionality | ||||
|   was enherited. | ||||
| 
 | ||||
|   Rev 1.14    1/1/2004 9:33:24 PM  BGooijen | ||||
|   the abstract class TIdReply was created sometimes, fixed that | ||||
| 
 | ||||
|   Rev 1.13    2003.10.18 9:33:28 PM  czhower | ||||
|   Boatload of bug fixes to command handlers. | ||||
| 
 | ||||
|   Rev 1.12    10/15/2003 7:49:38 PM  DSiders | ||||
|   Added IdResourceStringsCore to implementation uses clause. | ||||
| 
 | ||||
|   Rev 1.11    10/15/2003 7:46:42 PM  DSiders | ||||
|   Added formatted resource string for the exception raised in | ||||
|   TIdReply.SetCode. | ||||
| 
 | ||||
|   Rev 1.10    2003.09.06 1:30:30 PM  czhower | ||||
|   Removed abstract modifier from a class method so that C++ Builder can compile | ||||
|   again. | ||||
| 
 | ||||
|   Rev 1.9    2003.06.05 10:08:50 AM  czhower | ||||
|   Extended reply mechanisms to the exception handling. Only base and RFC | ||||
|   completed, handing off to J Peter. | ||||
| 
 | ||||
|   Rev 1.8    2003.05.30 10:25:56 PM  czhower | ||||
|   Implemented IsEndMarker | ||||
| 
 | ||||
|   Rev 1.7    2003.05.30 10:06:08 PM  czhower | ||||
|   Changed code property mechanisms. | ||||
| 
 | ||||
|   Rev 1.6    5/26/2003 04:29:56 PM  JPMugaas | ||||
|   Removed GenerateReply and ParseReply.  Those are now obsolete duplicate | ||||
|   functions in the new design. | ||||
| 
 | ||||
|   Rev 1.5    5/26/2003 12:19:54 PM  JPMugaas | ||||
| 
 | ||||
|   Rev 1.4    2003.05.26 11:38:18 AM  czhower | ||||
| 
 | ||||
|   Rev 1.3    2003.05.25 10:23:44 AM  czhower | ||||
| 
 | ||||
|   Rev 1.2    5/20/2003 12:43:46 AM  BGooijen | ||||
|   changeable reply types | ||||
| 
 | ||||
|   Rev 1.1    5/19/2003 05:54:58 PM  JPMugaas | ||||
| 
 | ||||
|   Rev 1.0    5/19/2003 12:26:16 PM  JPMugaas | ||||
|   Base class for reply format objects. | ||||
| } | ||||
| 
 | ||||
| unit IdReply; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$I IdCompilerDefines.inc} | ||||
| //we need to put this in Delphi mode to work | ||||
| 
 | ||||
| uses | ||||
|   Classes, | ||||
|   IdException; | ||||
| 
 | ||||
| type | ||||
|   TIdReplies = class; | ||||
|   //TODO: a streamed write only property will be registered to convert old DFMs | ||||
|   // into the new one for old TextCode and to ignore NumericCode which has been | ||||
|   // removed | ||||
|   TIdReply = class(TCollectionItem) | ||||
|   protected | ||||
|     FCode: string; | ||||
|     FFormattedReply: TStrings; | ||||
|     FReplyTexts: TIdReplies; | ||||
|     FText: TStrings; | ||||
|     // | ||||
|     procedure AssignTo(ADest: TPersistent); override; | ||||
|     procedure CommonInit; | ||||
|     function GetFormattedReplyStrings: TStrings; virtual; | ||||
|     function CheckIfCodeIsValid(const ACode: string): Boolean; virtual; | ||||
|     function GetDisplayName: string; override; | ||||
|     function GetFormattedReply: TStrings; virtual; | ||||
|     function GetNumericCode: Integer; | ||||
|     procedure SetCode(const AValue: string); | ||||
|     procedure SetFormattedReply(const AValue: TStrings); virtual; abstract; | ||||
|     procedure SetText(const AValue: TStrings); | ||||
|     procedure SetNumericCode(const AValue: Integer); | ||||
|   public | ||||
|     procedure Clear; virtual; | ||||
|     //Temp workaround for compiler bug | ||||
|     constructor Create(ACollection: TCollection); override; | ||||
|     constructor CreateWithReplyTexts(ACollection: TCollection; AReplyTexts: TIdReplies); virtual; | ||||
|     // Both creates are necessary. This base one is called by the collection editor at design time | ||||
|    // constructor Create(ACollection: TCollection); overload; override; | ||||
|    // constructor Create(ACollection: TCollection; AReplyTexts: TIdReplies); reintroduce; overload; virtual; | ||||
|     destructor Destroy; override; | ||||
|     // Is not abstract because C++ cannot compile abstract class methods | ||||
|     class function IsEndMarker(const ALine: string): Boolean; virtual; | ||||
|     procedure RaiseReplyError; virtual; abstract; | ||||
|     function ReplyExists: Boolean; virtual; | ||||
|     procedure SetReply(const ACode: Integer; const AText: string); overload; virtual; | ||||
|     procedure SetReply(const ACode: string; const AText: string); overload; virtual; | ||||
|     procedure UpdateText; | ||||
|     // | ||||
|     property FormattedReply: TStrings read GetFormattedReply write SetFormattedReply; | ||||
|     property NumericCode: Integer read GetNumericCode write SetNumericCode; | ||||
|   published | ||||
|     //warning: setting Code has a side-effect of calling Clear; | ||||
|     property Code: string read FCode write SetCode; | ||||
|     property Text: TStrings read FText write SetText; | ||||
|   end; | ||||
| 
 | ||||
|   TIdReplyClass = class of TIdReply; | ||||
| 
 | ||||
|   TIdReplies = class(TOwnedCollection) | ||||
|   protected | ||||
|     function GetItem(Index: Integer): TIdReply; | ||||
|     procedure SetItem(Index: Integer; const Value: TIdReply); | ||||
|   public | ||||
|     function Add: TIdReply; overload; | ||||
|     function Add(const ACode: Integer; const AText: string): TIdReply; overload; | ||||
|     function Add(const ACode, AText: string): TIdReply; overload; | ||||
|     constructor Create(AOwner: TPersistent; const AReplyClass: TIdReplyClass); reintroduce; virtual; | ||||
|     function Find(const ACode: string; AIgnore: TIdReply = nil): TIdReply; virtual; | ||||
|     procedure UpdateText(AReply: TIdReply); virtual; | ||||
|     // | ||||
|     property Items[Index: Integer]: TIdReply read GetItem write SetItem; default; | ||||
|   end; | ||||
| 
 | ||||
|   TIdRepliesClass = class of TIdReplies; | ||||
|   EIdReplyError = class(EIdException); | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdGlobal, IdResourceStringsCore, SysUtils; | ||||
| 
 | ||||
| { TIdReply } | ||||
| 
 | ||||
| procedure TIdReply.AssignTo(ADest: TPersistent); | ||||
| var | ||||
|   LR : TIdReply; | ||||
| begin | ||||
|   if ADest is TIdReply then begin | ||||
|     LR := TIdReply(ADest); | ||||
|     //set code first as it possibly clears the reply | ||||
|     LR.Code := Code; | ||||
|     LR.Text.Assign(Text); | ||||
|   end else begin | ||||
|     inherited AssignTo(ADest); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReply.Clear; | ||||
| begin | ||||
|   FText.Clear; | ||||
|   FCode := ''; | ||||
| end; | ||||
| 
 | ||||
| constructor TIdReply.CreateWithReplyTexts(ACollection: TCollection; AReplyTexts: TIdReplies); | ||||
| begin | ||||
|   inherited Create(ACollection); | ||||
|   FReplyTexts := AReplyTexts; | ||||
|   CommonInit; | ||||
| end; | ||||
| 
 | ||||
| constructor TIdReply.Create(ACollection: TCollection); | ||||
| begin | ||||
|   inherited Create(ACollection); | ||||
|   CommonInit; | ||||
| end; | ||||
| 
 | ||||
| destructor TIdReply.Destroy; | ||||
| begin | ||||
|   FreeAndNil(FText); | ||||
|   FreeAndNil(FFormattedReply); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReply.CommonInit; | ||||
| begin | ||||
|   FFormattedReply := TStringList.Create; | ||||
|   FText := TStringList.Create; | ||||
| end; | ||||
| 
 | ||||
| function TIdReply.GetDisplayName: string; | ||||
| begin | ||||
|   if Text.Count > 0 then begin | ||||
|     Result := Code + ' ' + Text[0]; | ||||
|   end else begin | ||||
|     Result := Code; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdReply.ReplyExists: Boolean; | ||||
| begin | ||||
|   Result := Code <> ''; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReply.SetNumericCode(const AValue: Integer); | ||||
| begin | ||||
|   Code := IntToStr(AValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReply.SetText(const AValue: TStrings); | ||||
| begin | ||||
|   FText.Assign(AValue); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReply.SetReply(const ACode: Integer; const AText: string); | ||||
| begin | ||||
|   SetReply(IntToStr(ACode), AText); | ||||
| end; | ||||
| 
 | ||||
| function TIdReply.GetNumericCode: Integer; | ||||
| begin | ||||
|   Result := IndyStrToInt(Code, 0); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReply.SetCode(const AValue: string); | ||||
| var | ||||
|   LMatchedReply: TIdReply; | ||||
| begin | ||||
|   if FCode <> AValue then begin | ||||
|     if not CheckIfCodeIsValid(AValue) then begin | ||||
|       raise EIdException.CreateFmt(RSReplyInvalidCode, [AValue]); | ||||
|     end; | ||||
|     // Only check for duplicates if we are in a collection. NormalReply etc are not in collections | ||||
|     // Also dont check FReplyTexts, as non members can be duplicates of members | ||||
|     if Collection <> nil then begin | ||||
|       LMatchedReply := TIdReplies(Collection).Find(AValue); | ||||
|       if Assigned(LMatchedReply) then begin | ||||
|         raise EIdException.CreateFmt(RSReplyCodeAlreadyExists, [AValue]); | ||||
|       end; | ||||
|     end; | ||||
|     Clear; | ||||
|     FCode := AValue; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReply.SetReply(const ACode, AText: string); | ||||
| begin | ||||
|   Code := ACode; | ||||
|   FText.Text := AText; | ||||
| end; | ||||
| 
 | ||||
| function TIdReply.CheckIfCodeIsValid(const ACode: string): Boolean; | ||||
| begin | ||||
|   Result := True; | ||||
| end; | ||||
| 
 | ||||
| class function TIdReply.IsEndMarker(const ALine: string): Boolean; | ||||
| begin | ||||
|   Result := False; | ||||
| end; | ||||
| 
 | ||||
| function TIdReply.GetFormattedReply: TStrings; | ||||
| begin | ||||
|   // Overrides must call GetFormattedReplyStrings instead. This is just a base implementation | ||||
|   // This is done this way because otherwise double generations can occur if more than one | ||||
|   // ancestor overrides. Example: Reply--> RFC --> FTP. Calling inherited would cause both | ||||
|   // FTP and RFC to generate. | ||||
|   Result := GetFormattedReplyStrings; | ||||
| end; | ||||
| 
 | ||||
| function TIdReply.GetFormattedReplyStrings: TStrings; | ||||
| begin | ||||
|   FFormattedReply.Clear; | ||||
|   Result := FFormattedReply; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReply.UpdateText; | ||||
| begin | ||||
|   if FReplyTexts <> nil then begin | ||||
|     FReplyTexts.UpdateText(Self); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| { TIdReplies } | ||||
| 
 | ||||
| function TIdReplies.Add: TIdReply; | ||||
| begin | ||||
|   Result := TIdReply(inherited Add); | ||||
| end; | ||||
| 
 | ||||
| function TIdReplies.Add(const ACode: Integer; const AText: string): TIdReply; | ||||
| begin | ||||
|   Result := Add(IntToStr(ACode), AText); | ||||
| end; | ||||
| 
 | ||||
| function TIdReplies.Add(const ACode, AText: string): TIdReply; | ||||
| begin | ||||
|   Result := Add; | ||||
|   try | ||||
|     Result.SetReply(ACode, AText); | ||||
|   except | ||||
|     FreeAndNil(Result); | ||||
|     raise; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| constructor TIdReplies.Create(AOwner: TPersistent; const AReplyClass: TIdReplyClass); | ||||
| begin | ||||
|   inherited Create(AOwner, AReplyClass); | ||||
| end; | ||||
| 
 | ||||
| function TIdReplies.Find(const ACode: string; AIgnore: TIdReply = nil): TIdReply; | ||||
| var | ||||
|   i: Integer; | ||||
| begin | ||||
|   Result := nil; | ||||
|   // Never return match on '' | ||||
|   if ACode <> '' then begin | ||||
|     for i := 0 to Count - 1 do begin | ||||
|       if Items[i].Code = ACode then begin | ||||
|         if not (Items[i] = AIgnore) then begin | ||||
|           Result := Items[i]; | ||||
|           Exit; | ||||
|         end; | ||||
|       end; | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdReplies.GetItem(Index: Integer): TIdReply; | ||||
| begin | ||||
|   Result := TIdReply(inherited Items[Index]); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReplies.SetItem(Index: Integer; const Value: TIdReply); | ||||
| begin | ||||
|   inherited SetItem(Index, Value); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReplies.UpdateText(AReply: TIdReply); | ||||
| var | ||||
|   LReply: TIdReply; | ||||
| begin | ||||
|   // If text is blank, get it from the ReplyTexts | ||||
|   if AReply.Text.Count = 0 then begin | ||||
|     // RLebeau - ignore AReply, it doesn't have any text | ||||
|     // to assign, or else the code wouldn't be this far | ||||
|     LReply := Find(AReply.Code, AReply); | ||||
|     if LReply <> nil then begin | ||||
|       AReply.Text.Assign(LReply.Text); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										312
									
								
								indy/Core/IdReplyRFC.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,312 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.29    1/15/05 2:28:28 PM  RLebeau | ||||
|   Added local variables to TIdReplyRFC.GetFormattedReply() to reduce the number | ||||
|   of repeated string operations that were being performed. | ||||
| 
 | ||||
|   Updated TIdRepliesRFC.UpdateText() to ignore the TIdReply that was passed in | ||||
|   when looking for a TIdReply to extract Text from. | ||||
| 
 | ||||
|   Rev 1.28    10/26/2004 8:43:00 PM  JPMugaas | ||||
|   Should be more portable with new references to TIdStrings and TIdStringList. | ||||
| 
 | ||||
|   Rev 1.27    6/11/2004 8:48:28 AM  DSiders | ||||
|   Added "Do not Localize" comments. | ||||
| 
 | ||||
|   Rev 1.26    18/05/2004 23:17:18  CCostelloe | ||||
|   Bug fix | ||||
| 
 | ||||
|   Rev 1.25    5/18/04 2:39:02 PM  RLebeau | ||||
|   Added second constructor to TIdRepliesRFC | ||||
| 
 | ||||
|   Rev 1.24    5/17/04 9:50:08 AM  RLebeau | ||||
|   Changed TIdRepliesRFC constructor to use 'reintroduce' instead | ||||
| 
 | ||||
|   Rev 1.23    5/16/04 5:12:04 PM  RLebeau | ||||
|   Added construvtor to TIdRepliesRFC class | ||||
| 
 | ||||
|   Rev 1.22    2004.03.01 5:12:36 PM  czhower | ||||
|   -Bug fix for shutdown of servers when connections still existed (AV) | ||||
|   -Implicit HELP support in CMDserver | ||||
|   -Several command handler bugs | ||||
|   -Additional command handler functionality. | ||||
| 
 | ||||
|   Rev 1.21    2004.02.29 8:17:20 PM  czhower | ||||
|   Minor cosmetic changes to code. | ||||
| 
 | ||||
|   Rev 1.20    2004.02.03 4:16:50 PM  czhower | ||||
|   For unit name changes. | ||||
| 
 | ||||
|   Rev 1.19    1/3/2004 8:06:18 PM  JPMugaas | ||||
|   Bug fix:  Sometimes, replies will appear twice due to the way functionality | ||||
|   was enherited. | ||||
| 
 | ||||
|   Rev 1.18    2003.10.18 9:33:28 PM  czhower | ||||
|   Boatload of bug fixes to command handlers. | ||||
| 
 | ||||
|   Rev 1.17    9/20/2003 10:01:04 AM  JPMugaas | ||||
|   Minor change.  WIll now accept all 3 digit numbers (not just ones below 600). | ||||
|   The reason is that developers may want something in 600-999 range.  RFC 2228 | ||||
|   defines a 6xx reply range for protected replies. | ||||
| 
 | ||||
|   Rev 1.16    2003.09.20 10:33:14 AM  czhower | ||||
|   Bug fix to allow clearing code field (Return to default value) | ||||
| 
 | ||||
|   Rev 1.15    2003.06.05 10:08:52 AM  czhower | ||||
|   Extended reply mechanisms to the exception handling. Only base and RFC | ||||
|   completed, handing off to J Peter. | ||||
| 
 | ||||
|   Rev 1.14    6/3/2003 04:09:30 PM  JPMugaas | ||||
|   class function TIdReplyRFC.IsEndMarker(const ALine: string): Boolean had the | ||||
|   wrong parameters causing FTP to freeze.  It probably effected other stuff. | ||||
| 
 | ||||
|   Rev 1.13    5/30/2003 8:37:42 PM  BGooijen | ||||
|   Changed virtual to override | ||||
| 
 | ||||
|   Rev 1.12    2003.05.30 10:25:58 PM  czhower | ||||
|   Implemented IsEndMarker | ||||
| 
 | ||||
|   Rev 1.11    2003.05.30 10:06:08 PM  czhower | ||||
|   Changed code property mechanisms. | ||||
| 
 | ||||
|   Rev 1.10    2003.05.26 10:48:12 PM  czhower | ||||
|   1) Removed deprecated code. | ||||
|   2) Removed POP3 bastardizations as they are now in IdReplyPOP3. | ||||
| 
 | ||||
|   Rev 1.9    5/26/2003 12:19:52 PM  JPMugaas | ||||
| 
 | ||||
|   Rev 1.8    2003.05.26 11:38:20 AM  czhower | ||||
| 
 | ||||
|   Rev 1.7    5/25/2003 03:16:54 AM  JPMugaas | ||||
| 
 | ||||
|   Rev 1.6    2003.05.25 10:23:46 AM  czhower | ||||
| 
 | ||||
|   Rev 1.5    5/21/2003 08:43:38 PM  JPMugaas | ||||
|   Overridable hook for the SMTP Reply object. | ||||
| 
 | ||||
|   Rev 1.4    5/20/2003 12:43:48 AM  BGooijen | ||||
|   changeable reply types | ||||
| 
 | ||||
|   Rev 1.3    5/19/2003 12:26:50 PM  JPMugaas | ||||
|   Now uses base class. | ||||
| 
 | ||||
|   Rev 1.2    11/05/2003 23:29:04  CCostelloe | ||||
|   IMAP-specific code moved up to TIdIMAP4.pas | ||||
| 
 | ||||
|   Rev 1.1    11/14/2002 02:51:54 PM  JPMugaas | ||||
|   Added FormatType property.  If it is rfIndentMidLines, it will accept | ||||
|   properly parse reply lines that begin with a space.  Setting this to | ||||
|   rfIndentMidLines will also cause the reply object to generate lines that | ||||
|   start with a space if the Text.Line starts with a space.  This should | ||||
|   accommodate the FTP MLSD and FEAT commands on both the client and server. | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:45:50 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdReplyRFC; | ||||
| 
 | ||||
| interface | ||||
| {$I IdCompilerDefines.inc} | ||||
| uses | ||||
|   Classes, | ||||
|   IdReply; | ||||
| 
 | ||||
| type | ||||
|   TIdReplyRFC = class(TIdReply) | ||||
|   protected | ||||
|     procedure AssignTo(ADest: TPersistent); override; | ||||
|     function CheckIfCodeIsValid(const ACode: string): Boolean; override; | ||||
|     function GetFormattedReply: TStrings; override; | ||||
|     procedure SetFormattedReply(const AValue: TStrings); override; | ||||
|   public | ||||
|     class function IsEndMarker(const ALine: string): Boolean; override; | ||||
|     procedure RaiseReplyError; override; | ||||
|     function ReplyExists: Boolean; override; | ||||
|   end; | ||||
| 
 | ||||
|   TIdRepliesRFC = class(TIdReplies) | ||||
|   public | ||||
|     constructor Create(AOwner: TPersistent); reintroduce; overload; virtual; | ||||
|     constructor Create(AOwner: TPersistent; const AReplyClass: TIdReplyClass); overload; override; | ||||
|     procedure UpdateText(AReply: TIdReply); override; | ||||
|   end; | ||||
| 
 | ||||
|   // This exception is for protocol errors such as 404 HTTP error and also | ||||
|   // SendCmd / GetResponse | ||||
|   EIdReplyRFCError = class(EIdReplyError) | ||||
|   protected | ||||
|     FErrorCode: Integer; | ||||
|   public | ||||
|     // Params must be in this order to avoid conflict with CreateHelp | ||||
|     // constructor in CBuilder as CB does not differentiate constructors | ||||
|     // by name as Delphi does | ||||
|     constructor CreateError(const AErrorCode: Integer; | ||||
|      const AReplyMessage: string); reintroduce; virtual; | ||||
|     // | ||||
|     property ErrorCode: Integer read FErrorCode; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   IdGlobal, | ||||
|   SysUtils; | ||||
| 
 | ||||
| { TIdReplyRFC } | ||||
| 
 | ||||
| procedure TIdReplyRFC.AssignTo(ADest: TPersistent); | ||||
| var | ||||
|   LR: TIdReplyRFC; | ||||
| begin | ||||
|   if ADest is TIdReplyRFC then begin | ||||
|     LR := TIdReplyRFC(ADest); | ||||
|     //set code first as it possibly clears the reply | ||||
|     LR.NumericCode := NumericCode; | ||||
|     LR.Text.Assign(Text); | ||||
|   end else begin | ||||
|     inherited AssignTo(ADest); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| function TIdReplyRFC.CheckIfCodeIsValid(const ACode: string): Boolean; | ||||
| var | ||||
|   LCode: Integer; | ||||
| begin | ||||
|   LCode := IndyStrToInt(ACode, 0); | ||||
|   {Replaced 600 with 999 because some developers may want 6xx, 7xx, and 8xx reply | ||||
|   codes for their protocols.  It also turns out that RFC 2228 defines 6xx reply codes. | ||||
| 
 | ||||
|   From RFC 2228 | ||||
| 
 | ||||
|    A new class of reply types (6yz) is also introduced for protected | ||||
|    replies. | ||||
|   } | ||||
|   Result := ((LCode >= 100) and (LCode < 1000)) or (Trim(ACode) = ''); | ||||
| end; | ||||
| 
 | ||||
| function TIdReplyRFC.GetFormattedReply: TStrings; | ||||
| var | ||||
|   I, LCode: Integer; | ||||
|   LCodeStr: String; | ||||
| begin | ||||
|   Result := GetFormattedReplyStrings; | ||||
|   LCode := NumericCode; | ||||
|   if LCode > 0 then begin | ||||
|     LCodeStr := IntToStr(LCode); | ||||
|     if Text.Count > 0 then begin | ||||
|       for I := 0 to Text.Count - 1 do begin | ||||
|         if I < Text.Count - 1 then begin | ||||
|           Result.Add(LCodeStr + '-' + Text[I]); | ||||
|         end else begin | ||||
|           Result.Add(LCodeStr + ' ' + Text[I]); | ||||
|         end; | ||||
|       end; | ||||
|     end else begin | ||||
|       Result.Add(LCodeStr); | ||||
|     end; | ||||
|   end else if FText.Count > 0 then begin | ||||
|     Result.AddStrings(FText); | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| class function TIdReplyRFC.IsEndMarker(const ALine: string): Boolean; | ||||
| begin | ||||
|   if Length(ALine) >= 4 then begin | ||||
|     Result := ALine[4] = ' '; | ||||
|   end else begin | ||||
|     Result := True; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReplyRFC.RaiseReplyError; | ||||
| begin | ||||
|   raise EIdReplyRFCError.CreateError(NumericCode, Text.Text); | ||||
| end; | ||||
| 
 | ||||
| function TIdReplyRFC.ReplyExists: Boolean; | ||||
| begin | ||||
|   Result := (NumericCode > 0) or (FText.Count > 0); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdReplyRFC.SetFormattedReply(const AValue: TStrings); | ||||
| // Just parse and put in items, no need to store after parse | ||||
| var | ||||
|   i: Integer; | ||||
|   s: string; | ||||
| begin | ||||
|   Clear; | ||||
|   if AValue.Count > 0 then begin | ||||
|     s := Trim(Copy(AValue[0], 1, 3)); | ||||
|     Code := s; | ||||
|     for i := 0 to AValue.Count - 1 do begin | ||||
|       Text.Add(Copy(AValue[i], 5, MaxInt)); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| { EIdReplyRFCError } | ||||
| 
 | ||||
| constructor EIdReplyRFCError.CreateError(const AErrorCode: Integer; | ||||
|  const AReplyMessage: string); | ||||
| begin | ||||
|   inherited Create(AReplyMessage); | ||||
|   FErrorCode := AErrorCode; | ||||
| end; | ||||
| 
 | ||||
| { TIdReplies } | ||||
| 
 | ||||
| constructor TIdRepliesRFC.Create(AOwner: TPersistent); | ||||
| begin | ||||
|   inherited Create(AOwner, TIdReplyRFC); | ||||
| end; | ||||
| 
 | ||||
| constructor TIdRepliesRFC.Create(AOwner: TPersistent; const AReplyClass: TIdReplyClass); | ||||
| begin | ||||
|   inherited Create(AOwner, AReplyClass); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdRepliesRFC.UpdateText(AReply: TIdReply); | ||||
| var | ||||
|   LGenericNumCode: Integer; | ||||
|   LReply: TIdReply; | ||||
| begin | ||||
|   inherited UpdateText(AReply); | ||||
|   // If text is still blank after inherited see if we can find a generic version | ||||
|   if AReply.Text.Count = 0 then begin | ||||
|     LGenericNumCode := (AReply.NumericCode div 100) * 100; | ||||
|     // RLebeau - in cases where the AReply.Code is the same as the | ||||
|     // generic code, ignore the AReply as it doesn't have any text | ||||
|     // to assign, or else the code wouldn't be this far | ||||
|     LReply := Find(IntToStr(LGenericNumCode), AReply); | ||||
|     if LReply = nil then begin | ||||
|       // If no generic was found, then use defaults. | ||||
|       case LGenericNumCode of | ||||
|         100: AReply.Text.Text := 'Information';            {do not localize} | ||||
|         200: AReply.Text.Text := 'Ok';                     {do not localize} | ||||
|         300: AReply.Text.Text := 'Temporary Error';        {do not localize} | ||||
|         400: AReply.Text.Text := 'Permanent Error';        {do not localize} | ||||
|         500: AReply.Text.Text := 'Unknown Internal Error'; {do not localize} | ||||
|       end; | ||||
|     end else begin | ||||
|       AReply.Text.Assign(LReply.Text); | ||||
|     end; | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										288
									
								
								indy/Core/IdResourceStringsCore.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,288 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.5    12/2/2004 9:26:44 PM  JPMugaas | ||||
|   Bug fix. | ||||
| 
 | ||||
|   Rev 1.4    11/11/2004 10:25:24 PM  JPMugaas | ||||
|   Added OpenProxy and CloseProxy so you can do RecvFrom and SendTo functions | ||||
|   from the UDP client with SOCKS.  You must call OpenProxy  before using | ||||
|   RecvFrom or SendTo.  When you are finished, you must use CloseProxy to close | ||||
|   any connection to the Proxy.  Connect and disconnect also call OpenProxy and | ||||
|   CloseProxy. | ||||
| 
 | ||||
|   Rev 1.3    11/11/2004 3:42:52 AM  JPMugaas | ||||
|   Moved strings into RS.  Socks will now raise an exception if you attempt to | ||||
|   use SOCKS4 and SOCKS4A with UDP.  Those protocol versions do not support UDP | ||||
|   at all. | ||||
| 
 | ||||
|   Rev 1.2    2004.05.20 11:39:12 AM  czhower | ||||
|   IdStreamVCL | ||||
| 
 | ||||
|   Rev 1.1    6/4/2004 5:13:26 PM  SGrobety | ||||
|   EIdMaxCaptureLineExceeded message string | ||||
| 
 | ||||
|   Rev 1.0    2004.02.03 4:19:50 PM  czhower | ||||
|   Rename | ||||
| 
 | ||||
|   Rev 1.15    10/24/2003 4:21:56 PM  DSiders | ||||
|   Addes resource string for stream read exception. | ||||
| 
 | ||||
|   Rev 1.14    2003.10.16 11:25:22 AM  czhower | ||||
|   Added missing ; | ||||
| 
 | ||||
|   Rev 1.13    10/15/2003 11:11:06 PM  DSiders | ||||
|   Added resource srting for exception raised in TIdTCPServer.SetScheduler. | ||||
| 
 | ||||
|   Rev 1.12    10/15/2003 11:03:00 PM  DSiders | ||||
|   Added resource string for circular links from transparent proxy. | ||||
|   Corrected spelling errors. | ||||
| 
 | ||||
|   Rev 1.11    10/15/2003 10:41:34 PM  DSiders | ||||
|   Added resource strings for TIdStream and TIdStreamProxy exceptions. | ||||
| 
 | ||||
|   Rev 1.10    10/15/2003 8:48:56 PM  DSiders | ||||
|   Added resource strings for exceptions raised when setting thread component | ||||
|   properties. | ||||
| 
 | ||||
|   Rev 1.9    10/15/2003 8:35:28 PM  DSiders | ||||
|   Added resource string for exception raised in TIdSchedulerOfThread.NewYarn. | ||||
| 
 | ||||
|   Rev 1.8    10/15/2003 8:04:26 PM  DSiders | ||||
|   Added resource strings for exceptions raised in TIdLogFile, TIdReply, and | ||||
|   TIdIOHandler. | ||||
| 
 | ||||
|   Rev 1.7    10/15/2003 1:03:42 PM  DSiders | ||||
|   Created resource strings for TIdBuffer.Find exceptions. | ||||
| 
 | ||||
|   Rev 1.6    2003.10.14 1:26:44 PM  czhower | ||||
|   Uupdates + Intercept support | ||||
| 
 | ||||
|   Rev 1.5    10/1/2003 10:49:02 PM  GGrieve | ||||
|   Rework buffer for Octane Compability | ||||
| 
 | ||||
|   Rev 1.4    7/1/2003 8:32:32 PM  BGooijen | ||||
|   Added RSFibersNotSupported | ||||
| 
 | ||||
|   Rev 1.3    7/1/2003 02:31:34 PM  JPMugaas | ||||
|   Message for invalid IP address. | ||||
| 
 | ||||
|   Rev 1.2    5/14/2003 6:40:22 PM  BGooijen | ||||
|   RS for transparent proxy | ||||
| 
 | ||||
|   Rev 1.1    1/17/2003 05:06:04 PM  JPMugaas | ||||
|   Exceptions for scheduler string. | ||||
| 
 | ||||
|   Rev 1.0    11/13/2002 08:42:02 AM  JPMugaas | ||||
| } | ||||
| 
 | ||||
| unit IdResourceStringsCore; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$i IdCompilerDefines.inc} | ||||
| 
 | ||||
| resourcestring | ||||
|   RSNoBindingsSpecified = 'No bindings specified.'; | ||||
|   RSCannotAllocateSocket = 'Cannot allocate socket.'; | ||||
|   RSSocksUDPNotSupported = 'UDP is not support in this SOCKS version.'; | ||||
|   RSSocksRequestFailed = 'Request rejected or failed.'; | ||||
|   RSSocksRequestServerFailed = 'Request rejected because SOCKS server cannot connect.'; | ||||
|   RSSocksRequestIdentFailed = 'Request rejected because the client program and identd report different user-ids.'; | ||||
|   RSSocksUnknownError = 'Unknown socks error.'; | ||||
|   RSSocksServerRespondError = 'Socks server did not respond.'; | ||||
|   RSSocksAuthMethodError = 'Invalid socks authentication method.'; | ||||
|   RSSocksAuthError = 'Authentication error to socks server.'; | ||||
|   RSSocksServerGeneralError = 'General SOCKS server failure.'; | ||||
|   RSSocksServerPermissionError = 'Connection not allowed by ruleset.'; | ||||
|   RSSocksServerNetUnreachableError = 'Network unreachable.'; | ||||
|   RSSocksServerHostUnreachableError = 'Host unreachable.'; | ||||
|   RSSocksServerConnectionRefusedError = 'Connection refused.'; | ||||
|   RSSocksServerTTLExpiredError = 'TTL expired.'; | ||||
|   RSSocksServerCommandError = 'Command not supported.'; | ||||
|   RSSocksServerAddressError = 'Address type not supported.'; | ||||
|   RSInvalidIPAddress = 'Invalid IP Address'; | ||||
|   RSInterceptCircularLink = '%s: Circular links are not allowed'; | ||||
| 
 | ||||
|   RSNotEnoughDataInBuffer = 'Not enough data in buffer. (%d/%d)'; | ||||
|   RSTooMuchDataInBuffer = 'Too much data in buffer.'; | ||||
|   RSCapacityTooSmall = 'Capacity cannot be smaller than Size.'; | ||||
|   RSBufferIsEmpty = 'No bytes in buffer.'; | ||||
|   RSBufferRangeError = 'Index out of bounds.'; | ||||
| 
 | ||||
|   RSFileNotFound = 'File "%s" not found'; | ||||
|   RSNotConnected = 'Not Connected'; | ||||
|   RSObjectTypeNotSupported = 'Object type not supported.'; | ||||
|   RSIdNoDataToRead = 'No data to read.'; | ||||
|   RSReadTimeout = 'Read timed out.'; | ||||
|   RSReadLnWaitMaxAttemptsExceeded = 'Max line read attempts exceeded.'; | ||||
|   RSAcceptTimeout = 'Accept timed out.'; | ||||
|   RSReadLnMaxLineLengthExceeded = 'Max line length exceeded.'; | ||||
|   RSRequiresLargeStream = 'Set LargeStream to True to send streams greater than 2GB'; | ||||
|   RSDataTooLarge = 'Data is too large for stream'; | ||||
|   RSConnectTimeout = 'Connect timed out.'; | ||||
|   RSICMPNotEnoughtBytes = 'Not enough bytes received'; | ||||
|   RSICMPNonEchoResponse = 'Non-echo type response received'; | ||||
|   RSThreadTerminateAndWaitFor  = 'Cannot call TerminateAndWaitFor on FreeAndTerminate threads'; | ||||
|   RSAlreadyConnected = 'Already connected.'; | ||||
|   RSTerminateThreadTimeout = 'Terminate Thread Timeout'; | ||||
|   RSNoExecuteSpecified = 'No execute handler found.'; | ||||
|   RSNoCommandHandlerFound = 'No command handler found.'; | ||||
|   RSCannotPerformTaskWhileServerIsActive = 'Cannot perform task while server is active.'; | ||||
|   RSThreadClassNotSpecified = 'Thread Class Not Specified.'; | ||||
|   RSMaximumNumberOfCaptureLineExceeded = 'Maximum number of line allowed exceeded'; // S.G. 6/4/2004: IdIOHandler.DoCapture | ||||
|   RSNoCreateListeningThread = 'Cannot create listening thread.'; | ||||
|   RSInterceptIsDifferent = 'The IOHandler already has a different Intercept assigned'; | ||||
| 
 | ||||
|   //scheduler | ||||
|   RSchedMaxThreadEx = 'The maximum number of threads for this scheduler is exceeded.'; | ||||
|   //transparent proxy | ||||
|   RSTransparentProxyCannotBind = 'Transparent proxy cannot bind.'; | ||||
|   RSTransparentProxyCanNotSupportUDP = 'UDP Not supported by this proxy.'; | ||||
|   //Fibers | ||||
|   RSFibersNotSupported = 'Fibers are not supported on this system.'; | ||||
|   // TIdICMPCast | ||||
|   RSIPMCastInvalidMulticastAddress = 'The supplied IP address is not a valid multicast address [224.0.0.0 to 239.255.255.255].'; | ||||
|   RSIPMCastNotSupportedOnWin32 = 'This function is not supported on Win32.'; | ||||
|   RSIPMCastReceiveError0 = 'IP Broadcast Receive Error = 0.'; | ||||
| 
 | ||||
|   // Log strings | ||||
|   RSLogConnected = 'Connected.'; | ||||
|   RSLogDisconnected = 'Disconnected.'; | ||||
|   RSLogEOL = '<EOL>';  // End of Line | ||||
|   RSLogCR  = '<CR>';   // Carriage Return | ||||
|   RSLogLF  = '<LF>';   // Line feed | ||||
|   RSLogRecv = 'Recv '; // Receive | ||||
|   RSLogSent = 'Sent '; // Send | ||||
|   RSLogStat = 'Stat '; // Status | ||||
| 
 | ||||
|   RSLogFileAlreadyOpen = 'Unable to set Filename while log file is open.'; | ||||
| 
 | ||||
|   RSBufferMissingTerminator = 'Buffer terminator must be specified.'; | ||||
|   RSBufferInvalidStartPos   = 'Buffer start position is invalid.'; | ||||
| 
 | ||||
|   RSIOHandlerCannotChange = 'Cannot change a connected IOHandler.'; | ||||
|   RSIOHandlerTypeNotInstalled = 'No IOHandler of type %s is installed.'; | ||||
| 
 | ||||
|   RSReplyInvalidCode = 'Reply Code is not valid: %s'; | ||||
|   RSReplyCodeAlreadyExists = 'Reply Code already exists: %s'; | ||||
| 
 | ||||
|   RSThreadSchedulerThreadRequired = 'Thread must be specified for the scheduler.'; | ||||
|   RSNoOnExecute = 'You must have an OnExecute event.'; | ||||
|   RSThreadComponentLoopAlreadyRunning = 'Cannot set Loop property when the Thread is already running.'; | ||||
|   RSThreadComponentThreadNameAlreadyRunning = 'Cannot set ThreadName when the Thread is already running.'; | ||||
| 
 | ||||
|   RSStreamProxyNoStack = 'A Stack has not been created for converting the data type.'; | ||||
| 
 | ||||
|   RSTransparentProxyCyclic = 'Transparent Proxy Cyclic error.'; | ||||
| 
 | ||||
|   RSTCPServerSchedulerAlreadyActive = 'Cannot change the scheduler while the server is Active.'; | ||||
|   RSUDPMustUseProxyOpen = 'You must use proxyOpen'; | ||||
| 
 | ||||
| //ICMP stuff | ||||
|   RSICMPTimeout = 'Timeout'; | ||||
| //Destination Address -3 | ||||
|   RSICMPNetUnreachable  = 'net unreachable;'; | ||||
|   RSICMPHostUnreachable = 'host unreachable;'; | ||||
|   RSICMPProtUnreachable = 'protocol unreachable;'; | ||||
|   RSICMPPortUnreachable = 'Port Unreachable'; | ||||
|   RSICMPFragmentNeeded = 'Fragmentation Needed and Don''t Fragment was Set'; | ||||
|   RSICMPSourceRouteFailed = 'Source Route Failed'; | ||||
|   RSICMPDestNetUnknown = 'Destination Network Unknown'; | ||||
|   RSICMPDestHostUnknown = 'Destination Host Unknown'; | ||||
|   RSICMPSourceIsolated = 'Source Host Isolated'; | ||||
|   RSICMPDestNetProhibitted = 'Communication with Destination Network is Administratively Prohibited'; | ||||
|   RSICMPDestHostProhibitted = 'Communication with Destination Host is Administratively Prohibited'; | ||||
|   RSICMPTOSNetUnreach =  'Destination Network Unreachable for Type of Service'; | ||||
|   RSICMPTOSHostUnreach = 'Destination Host Unreachable for Type of Service'; | ||||
|   RSICMPAdminProhibitted = 'Communication Administratively Prohibited'; | ||||
|   RSICMPHostPrecViolation = 'Host Precedence Violation'; | ||||
|   RSICMPPrecedenceCutoffInEffect =  'Precedence cutoff in effect'; | ||||
|   //for IPv6 | ||||
|   RSICMPNoRouteToDest = 'no route to destination'; | ||||
|   RSICMPAAdminDestProhibitted =  'communication with destination administratively prohibited'; | ||||
|   RSICMPSourceFilterFailed = 'source address failed ingress/egress policy'; | ||||
|   RSICMPRejectRoutToDest = 'reject route to destination'; | ||||
|   // Destination Address - 11 | ||||
|   RSICMPTTLExceeded     = 'time to live exceeded in transit'; | ||||
|   RSICMPHopLimitExceeded = 'hop limit exceeded in transit'; | ||||
|   RSICMPFragAsmExceeded = 'fragment reassembly time exceeded.'; | ||||
| //Parameter Problem - 12 | ||||
|   RSICMPParamError      = 'Parameter Problem (offset %d)'; | ||||
|   //IPv6 | ||||
|   RSICMPParamHeader = 'erroneous header field encountered (offset %d)'; | ||||
|   RSICMPParamNextHeader = 'unrecognized Next Header type encountered (offset %d)'; | ||||
|   RSICMPUnrecognizedOpt = 'unrecognized IPv6 option encountered (offset %d)'; | ||||
| //Source Quench Message -4 | ||||
|   RSICMPSourceQuenchMsg = 'Source Quench Message'; | ||||
| //Redirect Message | ||||
|   RSICMPRedirNet =        'Redirect datagrams for the Network.'; | ||||
|   RSICMPRedirHost =       'Redirect datagrams for the Host.'; | ||||
|   RSICMPRedirTOSNet =     'Redirect datagrams for the Type of Service and Network.'; | ||||
|   RSICMPRedirTOSHost =    'Redirect datagrams for the Type of Service and Host.'; | ||||
| //echo | ||||
|   RSICMPEcho = 'Echo'; | ||||
| //timestamp | ||||
|   RSICMPTimeStamp = 'Timestamp'; | ||||
| //information request | ||||
|   RSICMPInfoRequest = 'Information Request'; | ||||
| //mask request | ||||
|   RSICMPMaskRequest = 'Address Mask Request'; | ||||
| // Traceroute | ||||
|   RSICMPTracePacketForwarded = 'Outbound Packet successfully forwarded'; | ||||
|   RSICMPTraceNoRoute = 'No route for Outbound Packet; packet discarded'; | ||||
| //conversion errors | ||||
|   RSICMPConvUnknownUnspecError = 'Unknown/unspecified error'; | ||||
|   RSICMPConvDontConvOptPresent = 'Don''t Convert option present'; | ||||
|   RSICMPConvUnknownMandOptPresent =  'Unknown mandatory option present'; | ||||
|   RSICMPConvKnownUnsupportedOptionPresent = 'Known unsupported option present'; | ||||
|   RSICMPConvUnsupportedTransportProtocol = 'Unsupported transport protocol'; | ||||
|   RSICMPConvOverallLengthExceeded = 'Overall length exceeded'; | ||||
|   RSICMPConvIPHeaderLengthExceeded = 'IP header length exceeded'; | ||||
|   RSICMPConvTransportProtocol_255 = 'Transport protocol > 255'; | ||||
|   RSICMPConvPortConversionOutOfRange = 'Port conversion out of range'; | ||||
|   RSICMPConvTransportHeaderLengthExceeded = 'Transport header length exceeded'; | ||||
|   RSICMPConv32BitRolloverMissingAndACKSet = '32 Bit Rollover missing and ACK set'; | ||||
|   RSICMPConvUnknownMandatoryTransportOptionPresent =      'Unknown mandatory transport option present'; | ||||
| //mobile host redirect | ||||
|   RSICMPMobileHostRedirect = 'Mobile Host Redirect'; | ||||
| //IPv6 - Where are you | ||||
|   RSICMPIPv6WhereAreYou    = 'IPv6 Where-Are-You'; | ||||
| //IPv6 - I am here | ||||
|   RSICMPIPv6IAmHere        = 'IPv6 I-Am-Here'; | ||||
| // Mobile Regestration request | ||||
|   RSICMPMobReg             = 'Mobile Registration Request'; | ||||
| //Skip | ||||
|   RSICMPSKIP               = 'SKIP'; | ||||
| //Security | ||||
|   RSICMPSecBadSPI          = 'Bad SPI'; | ||||
|   RSICMPSecAuthenticationFailed = 'Authentication Failed'; | ||||
|   RSICMPSecDecompressionFailed = 'Decompression Failed'; | ||||
|   RSICMPSecDecryptionFailed = 'Decryption Failed'; | ||||
|   RSICMPSecNeedAuthentication = 'Need Authentication'; | ||||
|   RSICMPSecNeedAuthorization = 'Need Authorization'; | ||||
| //IPv6 Packet Too Big | ||||
|   RSICMPPacketTooBig = 'Packet Too Big (MTU = %d)'; | ||||
| { TIdCustomIcmpClient } | ||||
| 
 | ||||
|   // TIdSimpleServer | ||||
|   RSCannotUseNonSocketIOHandler = 'Cannot use a non-socket IOHandler'; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| end. | ||||
							
								
								
									
										195
									
								
								indy/Core/IdScheduler.pas
									
									
									
									
									
										Normal file
									
								
							
							
						
						| @ -0,0 +1,195 @@ | ||||
| { | ||||
|   $Project$ | ||||
|   $Workfile$ | ||||
|   $Revision$ | ||||
|   $DateUTC$ | ||||
|   $Id$ | ||||
| 
 | ||||
|   This file is part of the Indy (Internet Direct) project, and is offered | ||||
|   under the dual-licensing agreement described on the Indy website. | ||||
|   (http://www.indyproject.org/) | ||||
| 
 | ||||
|   Copyright: | ||||
|    (c) 1993-2005, Chad Z. Hower and the Indy Pit Crew. All rights reserved. | ||||
| } | ||||
| { | ||||
|   $Log$ | ||||
| } | ||||
| { | ||||
|   Rev 1.14    4/8/2004 11:55:30 AM  BGooijen | ||||
|   Fix for D5 | ||||
| 
 | ||||
|   Rev 1.13    2004.03.01 5:12:38 PM  czhower | ||||
|   -Bug fix for shutdown of servers when connections still existed (AV) | ||||
|   -Implicit HELP support in CMDserver | ||||
|   -Several command handler bugs | ||||
|   -Additional command handler functionality. | ||||
| 
 | ||||
|   Rev 1.12    2004.01.20 10:03:30 PM  czhower | ||||
|   InitComponent | ||||
| 
 | ||||
|   Rev 1.11    2003.10.21 12:18:58 AM  czhower | ||||
|   TIdTask support and fiber bug fixes. | ||||
| 
 | ||||
|   Rev 1.10    2003.10.14 11:18:08 PM  czhower | ||||
|   Fix for AV on shutdown and other bugs | ||||
| 
 | ||||
|   Rev 1.9    2003.10.11 5:49:24 PM  czhower | ||||
|   -VCL fixes for servers | ||||
|   -Chain suport for servers (Super core) | ||||
|   -Scheduler upgrades | ||||
|   -Full yarn support | ||||
| 
 | ||||
|   Rev 1.8    2003.09.19 10:11:16 PM  czhower | ||||
|   Next stage of fiber support in servers. | ||||
| 
 | ||||
|   Rev 1.7    2003.09.19 11:54:30 AM  czhower | ||||
|   -Completed more features necessary for servers | ||||
|   -Fixed some bugs | ||||
| 
 | ||||
|   Rev 1.6    2003.09.18 4:10:24 PM  czhower | ||||
|   Preliminary changes for Yarn support. | ||||
| 
 | ||||
|   Rev 1.5    3/27/2003 5:15:36 PM  BGooijen | ||||
|   Moved some code from subclasses here, made MaxThreads published | ||||
| 
 | ||||
|   Rev 1.4    3/13/2003 10:18:36 AM  BGooijen | ||||
|   Server side fibers, bug fixes | ||||
| 
 | ||||
|   Rev 1.1    1/23/2003 11:06:04 AM  BGooijen | ||||
| 
 | ||||
|   Rev 1.0    1/17/2003 03:41:48 PM  JPMugaas | ||||
|   Scheduler base class. | ||||
| } | ||||
| 
 | ||||
| unit IdScheduler; | ||||
| 
 | ||||
| interface | ||||
| 
 | ||||
| {$i IdCompilerDefines.inc} | ||||
| 
 | ||||
| uses | ||||
|   {$IFDEF HAS_UNIT_Generics_Collections} | ||||
|   System.Generics.Collections, | ||||
|   {$ELSE} | ||||
|     {$IFDEF VCL_XE3_OR_ABOVE} | ||||
|   System.Classes, | ||||
|     {$ELSE} | ||||
|   Classes, | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   IdBaseComponent, IdThread, IdTask, IdYarn, IdThreadSafe; | ||||
| 
 | ||||
| type | ||||
|   {$IFDEF HAS_GENERICS_TThreadList} | ||||
|   TIdYarnThreadList = TIdThreadSafeObjectList<TIdYarn>; | ||||
|   TIdYarnList = TList<TIdYarn>; | ||||
|   {$ELSE} | ||||
|   // TODO: flesh out to match TIdThreadSafeObjectList<TIdYarn> and TList<TIdYarn> for non-Generics compilers | ||||
|   TIdYarnThreadList = TIdThreadSafeObjectList; | ||||
|   TIdYarnList = TList; | ||||
|   {$ENDIF} | ||||
| 
 | ||||
|   TIdScheduler = class(TIdBaseComponent) | ||||
|   protected | ||||
|     FActiveYarns: TIdYarnThreadList; | ||||
|     // | ||||
|     procedure InitComponent; override; | ||||
|   public | ||||
|     destructor Destroy; override; | ||||
|     function AcquireYarn: TIdYarn; virtual; abstract; | ||||
|     procedure Init; virtual; | ||||
|     // ReleaseYarn is to remove a yarn from the list that has already been | ||||
|     // terminated (usually self termination); | ||||
|     procedure ReleaseYarn(AYarn: TIdYarn); virtual; | ||||
|     procedure StartYarn(AYarn: TIdYarn; ATask: TIdTask); virtual; abstract; | ||||
|     // TerminateYarn is to terminate a yarn explicitly and remove it also | ||||
|     procedure TerminateYarn(AYarn: TIdYarn); virtual; abstract; | ||||
|     procedure TerminateAllYarns; virtual; | ||||
|     // | ||||
|     property ActiveYarns: TIdYarnThreadList read FActiveYarns; | ||||
|   end; | ||||
| 
 | ||||
| implementation | ||||
| 
 | ||||
| uses | ||||
|   //facilitate inlining only. | ||||
|   {$IFDEF DOTNET} | ||||
|     {$IFDEF USE_INLINE} | ||||
|   System.Threading, | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   {$IFDEF VCL_2010_OR_ABOVE} | ||||
|     {$IFDEF WINDOWS} | ||||
|   Windows, | ||||
|     {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   {$IFDEF USE_VCL_POSIX} | ||||
|   Posix.SysSelect, | ||||
|   Posix.SysTime, | ||||
|   {$ENDIF} | ||||
|   {$IFDEF HAS_UNIT_Generics_Collections} | ||||
|     {$IFDEF VCL_XE3_OR_ABOVE} | ||||
|   System.Classes, | ||||
|   System.Types, | ||||
|     {$ELSE} | ||||
|   Classes, | ||||
|     {$ENDIF} | ||||
|   {$ELSE} | ||||
|       {$IFDEF VCL_XE3_OR_ABOVE} | ||||
|   System.Types,    //here to facilitate inlining | ||||
|       {$ENDIF} | ||||
|   {$ENDIF} | ||||
|   IdGlobal, SysUtils; | ||||
| 
 | ||||
| { TIdScheduler } | ||||
| 
 | ||||
| destructor TIdScheduler.Destroy; | ||||
| begin | ||||
|   FreeAndNil(FActiveYarns); | ||||
|   inherited Destroy; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdScheduler.Init; | ||||
| begin | ||||
| end; | ||||
| 
 | ||||
| procedure TIdScheduler.InitComponent; | ||||
| begin | ||||
|   inherited InitComponent; | ||||
|   FActiveYarns := TIdYarnThreadList.Create; | ||||
| end; | ||||
| 
 | ||||
| procedure TIdScheduler.ReleaseYarn(AYarn: TIdYarn); | ||||
| begin | ||||
|   ActiveYarns.Remove(AYarn); | ||||
| end; | ||||
| 
 | ||||
| procedure TIdScheduler.TerminateAllYarns; | ||||
| var | ||||
|   i: Integer; | ||||
|   LList: TIdYarnList; | ||||
| begin | ||||
|   Assert(FActiveYarns<>nil); | ||||
| 
 | ||||
|   while True do begin | ||||
|     // Must unlock each time to allow yarns that are terminating to remove themselves from the list | ||||
|     LList := FActiveYarns.LockList; | ||||
|     try | ||||
|       if LList.Count = 0 then begin | ||||
|         Break; | ||||
|       end; | ||||
|       for i := LList.Count - 1 downto 0 do begin | ||||
|         TerminateYarn( | ||||
|           {$IFDEF HAS_GENERICS_TList}LList.Items[i]{$ELSE}TIdYarn(LList.Items[i]){$ENDIF} | ||||
|         ); | ||||
|       end; | ||||
|     finally | ||||
|       FActiveYarns.UnlockList; | ||||
|     end; | ||||
|     //TODO: Put terminate timeout check back | ||||
|     IndySleep(500); // Wait a bit before looping to prevent thrashing | ||||
|   end; | ||||
| end; | ||||
| 
 | ||||
| end. | ||||