source: trunk/Sibyl/Addon/INET.PAS@ 377

Last change on this file since 377 was 7, checked in by RBRi, 19 years ago

+ sibyl staff
  • Property svn:eol-style set to native
File size: 89.7 KB
Line 
1Unit INet;
2
3Interface
4
5Uses SysUtils,Classes,Forms,Dialogs;
6
7{$IFDEF OS2}
8Uses Os2Def,BseDos,PmWin;
9{$ENDIF}
10
11{$IFDEF WIN95}
12Uses WinBase;
13{$ENDIF}
14
15Const
16 //Common MIME pairs
17 MIME_IMAGE_GIF ='image/gif';
18 MIME_IMAGE_JPEG ='image/jpeg';
19 MIME_IMAGE_xBitmap ='image/x-xbitmap';
20 MIME_IMAGE_BMP ='image/bmp';
21
22 MIME_APP_PDF ='application/pdf';
23
24/* WX_* window messages */
25Const
26 WX_MOUSEMOVE = WM_USER + 1000;
27 WX_BUTTONCLICK = WM_USER + 1001;
28 WX_LOADRESULT = WM_USER + 1004;
29 WX_LOADSTATUS = WM_USER + 1005;
30 WX_PRINTRESULT = WM_USER + 1006;
31 WX_MSGERROR = WM_USER + 1007;
32 WX_MSGINFO = WM_USER + 1008;
33 WX_MSGSTATUS = WM_USER + 1009;
34 WX_DISPLAYDIALOG = WM_USER + 1010;
35 WX_MSGSECURITY = WM_USER + 1011;
36 WX_CHANGEEXPIREDPASSWD = WM_USER + 1012;
37 WX_SELNEWPRIVKEY = WM_USER + 1013;
38
39/* Error Messages */
40Const
41 WXENONE = 0;
42 WXEINVAL = 1;
43 WXEINPROGRESS = 2;
44 WXEFILE = 3;
45 WXENODOC = 4;
46 WXEBUFSIZE = 5;
47 WXENOPROXY = 6;
48 WXENOSOCKS = 7;
49 WXEMIME = 8;
50 WXENOTFOUND = 9;
51 WXEINTR = 10;
52 WXENOANCHOR = 11;
53
54Type
55 {$M+}
56 THTTPPos = Record
57 Component:LongWord;
58 x:Word;
59 y:Word;
60 End;
61
62 THTTPFontSize=(httpFontSmall,httpFontNormal,httpFontLarge,httpFontXLarge);
63
64 THTTPGateway=(httpGatewayNone,httpGatewayProxy,httpGatewaySocks,httpGatewayProxySocks);
65
66 THTTPLoadStatus=(httpLoadSuccess,httpLoadCancelled,httpLoadError);
67
68 THTTPOnLoad=Procedure(Sender:TObject;Status:THTTPLoadStatus) Of Object;
69
70 THTTPOnMouseEvent=Procedure(Sender:TObject;Const Pos:THTTPPos) Of Object;
71
72 THTTPSearchOptions=(httpSearchForward,httpSearchBackward);
73
74 THTTPAnchorState=(httpAnchorDefault,httpAnchorVisited);
75 {$M-}
76
77 THTTPBrowser=Class(TControl)
78 Private
79 FInlineGraphicsAssigned:Boolean;
80 FInlineGraphics:Boolean;
81 FUnderlineAnchorsAssigned:Boolean;
82 FUnderlineAnchors:Boolean;
83 FHTTPFontSizeAssigned:Boolean;
84 FHTTPFontSize:THTTPFontSize;
85 FEmailAddress:PString;
86 FNewsServer:PString;
87 FProxyServer:PString;
88 FSocksServer:PString;
89 FGatewayAssigned:Boolean;
90 FGateway:THTTPGateway;
91 FEnableCacheAssigned:Boolean;
92 FEnableCache:Boolean;
93 FCacheDocLimitAssigned:Boolean;
94 FCacheDocLimit:LongInt;
95 FCacheImageLimitAssigned:Boolean;
96 FCacheImageLimit:LongInt;
97 FCacheDir:PString;
98
99 FOnLoad:THTTPOnLoad;
100 FOnDocMouseClick:THTTPOnMouseEvent;
101 FOnDocMouseMove:THTTPOnMouseEvent;
102
103 FLoaded:Boolean;
104 FLoadCancel:Boolean;
105 FURL:PString;
106 FDLLHandle:LongWord;
107 FWXViewQueryVersion:Function:Word;APIENTRY;
108 FWXViewQueryDisplayOpts:Function(hwndView:LongWord;Var wxDisplayOpts;
109 usSize:Word):LongWord;APIENTRY
110 FWXViewSetDisplayOpts:Function(hwndView:LongWord;Var wxDisplayOpts;
111 usSize:Word):LongWord;APIENTRY;
112 FWXViewLoad:Function(hwndView:LongWord;pcszURL:PChar;
113 wxLoadFlags:LongWord;Const pwxAnchorData):LongWord;APIENTRY;
114 FWXViewQueryViewer:Function(hwndView:LongWord;pcszMIMEType:PChar;
115 Var Viewer;usSize:Word):LongWord;APIENTRY;
116 FWXViewSetViewer:Function(hwndView:LongWord;Var pwxViewer;
117 usSize:Word):LongWord;APIENTRY;
118 FWXViewQueryNetworkOpts:Function(hwndView:LongWord;Var Opts;
119 usSize:Word):LongInt;APIENTRY;
120 FWXViewSetNetworkOpts:Function(hwndView:LongWord;Var Opts;
121 usSize:Word):LongInt;APIENTRY;
122 FWXViewEnableGateway:Function(hwndView:LongWord;wxGateway:LongWord):LongInt;APIENTRY;
123 FWXViewQueryCacheOpts:Function(hwndView:LongWord;Var Opts;
124 usSize:Word):Longint;APIENTRY;
125 FWXViewSetCacheOpts:Function(hwndView:LongWord;Var Opts;
126 usSize:Word):Longint;APIENTRY;
127 FWXViewCancelLoad:Function(hwndView:LongWord):LongInt;APIENTRY;
128 FWXViewQueryDocTitle:Function(hwndView:LongWord;pszTitle:PChar;
129 usLen:Word):LongInt;APIENTRY;
130 FWXViewQueryAnchorData:Function(hwndView:LongWord;Const pwxPos;
131 var pwxAnchorData;usLen:Word):LongInt;APIENTRY;
132 FWXViewQueryAnchorDataLen:Function(hwndView:LongWord;Const pwxPos):Word;APIENTRY;
133 FWXViewQueryAnchor:Function(hwndView:LongWord;Const pwxPos;pszAnchor:PChar;
134 usLen:Word):LongInt;APIENTRY;
135 FWXViewQueryPos:Function(hwndView:LongWord;x,y:Word;
136 Const pwxPos):LongInt;APIENTRY;
137 FWXViewLoadToFile:Function(hwndView:LongWord;pcszURL,pcszFileName:PChar;
138 wxLoadFlags:LongWord;Const pwxAnchorData):LongInt;APIENTRY;
139 FWXViewQueryDocAnchor:Function(hwndView:LongWord;pszAnchor:PChar;
140 usLen:Word):LongInt;APIENTRY;
141 FWXViewSearch:Function(hwndView:LongWord;wxSearchOpts:LongWord;
142 Const pwStartPos;Var pwNextPos;
143 pcszSearchData:PChar):LongInt;APIENTRY;
144 FWXViewIsLoading:Function(hwndView:LongWord):BOOL;APIENTRY;
145 FWXViewQueryAnchorState:Function(hwndView:LongWord;pcszAnchor:PChar;
146 Var pwxAnchorOpts:LongWord):LongInt;APIENTRY;
147 FWXViewSetAnchorState:Function(hwndView:LongWord;pcszAnchor:PChar;
148 wxAnchorOpts:LongWord):LongInt;APIENTRY;
149 FWXViewQueryLastError:Function(hwndView:LongWord):LongInt;APIENTRY
150 FWXViewQueryLastLoadError:Function(hwndView:LongWord):LongInt;APIENTRY;
151
152 Private
153 Function GetURL:String;
154 Procedure SetURL(NewValue:String);
155 Function GetVersion:Word;
156 Function GetInlineGraphics:Boolean;
157 Procedure SetInlineGraphics(NewValue:Boolean);
158 Function GetUnderlineAnchors:Boolean;
159 Procedure SetUnderlineAnchors(NewValue:Boolean);
160 Function GetHTTPFontSize:THTTPFontSize;
161 Procedure SetHTTPFontSize(NewValue:THTTPFontSize);
162 Function GetEmailAddress:String;
163 Procedure SetEmailAddress(NewValue:String);
164 Function GetNewsServer:String;
165 Procedure SetNewsServer(NewValue:String);
166 Function GetProxyServer:String;
167 Procedure SetProxyServer(NewValue:String);
168 Function GetSocksServer:String;
169 Procedure SetSocksServer(NewValue:String);
170 Function GetGateway:THTTPGateway;
171 Procedure SetGateway(NewValue:THTTPGateway);
172 Function GetEnableCache:Boolean;
173 Procedure SetEnableCache(NewValue:Boolean);
174 Function GetCacheDocLimit:LongInt;
175 Procedure SetCacheDocLimit(NewValue:LongInt);
176 Function GetCacheImageLimit:LongInt;
177 Procedure SetCacheImageLimit(NewValue:LongInt);
178 Function GetCacheDir:String;
179 Procedure SetCacheDir(NewValue:String);
180 Procedure SetLoaded(NewValue:Boolean);
181 Function GetDocTitle:String;
182 Function GetIsLoading:Boolean;
183 Function GetAnchorState(Const Anchor:String):THTTPAnchorState;
184 Procedure SetAnchorState(Const Anchor:String;NewValue:THTTPAnchorState);
185 Function GetLastLoadError:LongInt;
186 Function GetLastError:LongInt;
187 Protected
188 Procedure GetClassData(Var ClassData:TClassData);Override;
189 Procedure SetupShow;Override;
190 Procedure WXLoadResult(Var Msg:TMessage); message WX_LOADRESULT;
191 Procedure WXButtonClick(Var Msg:TMessage); message WX_BUTTONCLICK;
192 Procedure WXMouseMove(Var Msg:TMessage); message WX_MOUSEMOVE;
193 Procedure SetupComponent;Override;
194 Public
195 Destructor Destroy;Override;
196 Function GetMIMEViewer(MIMEPair:String):String;
197 Procedure SetMIMEViewer(MIMEPair,EXEProgram:String);
198 Procedure Load;
199 Procedure LoadWithAnchor(Var Anchor);
200 Function LoadToFile(Const FileName:String):Boolean;
201 Function LoadToFileWithAnchor(Const FileName:String;Var Anchor):Boolean;
202 Procedure CancelLoad;
203 Function GetAnchorDataLen(Const Pos:THTTPPos):LongWord;
204 Function GetAnchorData(Const Pos:THTTPPos;Var Buf;BufLen:LongWord):Boolean;
205 Function GetAnchor(Const Pos:THTTPPos):String;
206 Function GetDocAnchor:String;
207 Function Search(Const s:String;Const StartPos:THTTPPos;Options:THTTPSearchOptions):THTTPPos;
208 Public
209 Property Version:Word read GetVersion;
210 Property DocTitle:String read GetDocTitle;
211 Property IsLoading:Boolean read GetIsLoading;
212 Property AnchorState[Const Anchor:String]:THTTPAnchorState read GetAnchorState write SetAnchorState;
213 Property LastLoadError:LongInt read GetLastLoadError;
214 Property LastError:LongInt read GetLastError;
215 Published
216 Property Align;
217 Property DragCursor;
218 Property DragMode;
219 Property Enabled;
220 Property ParentShowHint;
221 Property PopupMenu;
222 Property ShowHint;
223 Property TabOrder;
224 Property TabStop;
225 Property Visible;
226 Property ZOrder;
227
228 Property OnCanDrag;
229 Property OnDragDrop;
230 Property OnDragOver;
231 Property OnEndDrag;
232 Property OnEnter;
233 Property OnExit;
234 Property OnFontChange;
235 Property OnKeyPress;
236 Property OnScan;
237 Property OnSetupShow;
238 Property OnStartDrag;
239
240 Property URL:String read GetURL write SetURL;
241 Property InlineGraphics:Boolean read GetInlineGraphics write SetInlineGraphics;
242 Property UnderlineAnchors:Boolean read GetUnderlineAnchors write SetUnderlineAnchors;
243 Property httpFontSize:THTTPFontSize read GetHTTPFontSize write SetHTTPFontSize;
244 Property EmailAddress:String read GetEmailAddress write SetEmailAddress;
245 Property NewsServer:String read GetNewsServer write SetNewsServer;
246 Property ProxyServer:String read GetProxyServer write SetProxyServer;
247 Property SocksServer:String read GetSocksServer write SetSocksServer;
248 Property Gateway:THTTPGateway read GetGateway write SetGateway;
249 Property EnableCache:Boolean read GetEnableCache write SetEnableCache;
250 Property CacheDocLimit:LongInt read GetCacheDocLimit write SetCacheDocLimit;
251 Property CacheImageLimit:LongInt read GetCacheImageLimit write SetCacheImageLimit;
252 Property CacheDir:String read GetCacheDir write SetCacheDir;
253 Property Loaded:Boolean read FLoaded write SetLoaded;
254
255 Property OnLoad:THTTPOnLoad read FOnLoad write FOnLoad;
256 Property OnDocMouseClick:THTTPOnMouseEvent read FOnDocMouseClick write FOnDocMouseClick;
257 Property OnDocMouseMove:THTTPOnMouseEvent read FOnDocMouseMove write FOnDocMouseMove;
258 End;
259
260 {$M+}
261 TFTPError=(ftpOk,ftpUnknownService,ftpUnkownHost,ftpSocketError,ftpCannotConnect,
262 ftpLoginFailed,ftpTransferAborted,ftpCannotOpenFile,ftpConnectionError,
263 fptCommandFailed,ftpProxyError,ftpNoPrimaryProxy,ftpNoTranslateTable,
264 ftpNotConnected,ftpOther);
265
266 TOnFTPError=Procedure(Sender:TObject;Err:TFTPError;Const Description:String) Of Object;
267
268 TFTPDirOptions=(ftpDirWide,ftpDirShort);
269
270 TFTPTransferMode=(ftpAscii,ftpBinary);
271
272 TFTPPingResult=(ftpPingOk,ftpPingHostDoesNotReply,ftpPingSocketError,
273 ftpPingUnkownProtocol,ftpPingSendFailed,ftpPingReceiveFailed,
274 ftpPingUnkownHost,ftpPingOther);
275
276 TFTPOnTransferProgress=Procedure(Sender:TObject;TransferredBytes,TotalBytes:LongInt) Of Object;
277 {$M-}
278
279 TFTP=Class(TComponent)
280 Private
281 FPassWord:PString;
282 FRemoteHost:PString;
283 FRemoteAccount:PString;
284 FUserId:PString;
285 FDLLHandle:LongWord;
286 FConnected:Boolean;
287 FTransferMode:TFTPTransferMode;
288 FOnFTPError:TOnFTPError;
289
290 Fftplogoff:Procedure;APIENTRY;
291 Fftpget:Function(Const Host,UserId,Pwd,Account,Local,Remote,Mode:CString;
292 TransferType:LongInt):Longint;APIENTRY;
293 Fftpput:Function(Const Host,UserId,Pwd,Account,Local,Remote:CString;
294 TransferType:LongInt):LongInt;APIENTRY;
295 Fftpappend:Function(Const Host,UserId,Pwd,Account,Local,Remote:CString;
296 TransferType:LongInt):Longint;APIENTRY;
297 Fftpputunique:Function(Const Host,UserId,Pwd,Account,Local,Remote:CString;
298 TransferType:LongInt):LongInt;APIENTRY;
299 Fftpcd:Function(Const Host,UserId,Pwd,Account,Dir:CString):LongInt;APIENTRY;
300 Fftpmkd:Function(Const Host,UserId,Pwd,Account,Dir:CString):LongInt;APIENTRY;
301 Fftprmd:Function(Const Host,UserId,Pwd,Account,Dir:CString):LongInt;APIENTRY;
302 Fftpdelete:Function(Const Host,UserId,Pwd,Account,Name:CString):LongInt;APIENTRY;
303 Fftprename:Function(Const Host,UserId,Pwd,Account,NameFrom,NameTo:CString):LongInt;APIENTRY;
304 Fftpls:Function(Const Host,UserId,Pwd,Account,Local,Pattern:CString):LongInt;APIENTRY;
305 Fftpdir:Function(Const Host,UserId,Pwd,Account,Local,Pattern:CString):LongInt;APIENTRY;
306 Fftpquote:Function(Const Host,UserId,Pwd,Account,QuoteStr:CString):LongInt;APIENTRY;
307 Fftpping:Function(Const Host:CString;Len:LongInt;Var Addr:LongWord):LongInt;APIENTRY;
308 Fftppwd:Function(Const Host,UserId,Pwd,Account:CString;Var Buf:CString;BufLen:LongInt):LongInt;APIENTRY;
309 Fftpsys:Function(Const Host,UserId,Pwd,Account:CString;Var Buf:CString;BufLen:LongInt):LongInt;APIENTRY;
310 Fftpver:Function(Var Buf:CString;BufLen:LongInt):LongInt;APIENTRY;
311 FftpWindow:Procedure(Handle:LongWord);
312 Fftp_errno:Function:LongInt;APIENTRY;
313
314 FNotifyControl:TControl;
315 FOnTransferProgress:TFTPOnTransferProgress;
316 FOnError:TOnFTPError;
317 Private
318 Function GetPassWord:String;
319 Procedure SetPassWord(NewValue:String);
320 Function GetRemoteHost:String;
321 Procedure SetRemoteHost(NewValue:String);
322 Function GetRemoteAccount:String;
323 Procedure SetRemoteAccount(NewValue:String);
324 Function GetUserID:String;
325 Procedure SetUserID(NewValue:String);
326 Function GetRemoteDirName:String;
327 Procedure SetRemoteDirName(NewValue:String);
328 Function GetFTPError:TFTPError;
329 Procedure SetConnected(NewValue:Boolean);
330 Function GetVersion:String;
331 Function GetSystem:String;
332 Protected
333 Procedure SetupComponent;Override;
334 Public
335 Destructor Destroy;Override;
336 Function Connect:TFTPError;
337 Procedure Disconnect;
338 Function GetRemoteDir(Const Pattern:String;Dir:TStrings;Options:TFTPDirOptions):TFTPError;
339 Function DeleteRemoteFile(Const FileName:String):TFTPError;
340 Function RenameRemoteFile(Const OldName,NewName:String):TFTPError;
341 Function MakeRemoteDir(Const DirName:String):TFTPError;
342 Function RemoveRemoteDir(Const DirName:String):TFTPError;
343 Function AppendToRemoteFile(Const RemoteFileName,LocalFileName:String):TFTPError;
344 Function GetRemoteFile(Const RemoteFileName,LocalFileName:String):TFTPError;
345 Function PutLocalFile(Const LocalFileName,RemoteFileName:String):TFTPError;
346 Function PutUniqueLocalFile(Const LocalFileName,RemoteFileName:String):TFTPError;
347 Function Quote(Const ftpstring:String):TFTPError;
348 Function Ping(Const HostName:String;PacketLen:LongInt;
349 Var Address:LongWord;Var Milliseconds:LongInt):TFTPPingResult;
350 Procedure FTPError(Err:TFTPError);VIRTUAL;
351 Public
352 Property Connected:Boolean read FConnected write SetConnected;
353 Property Version:String read GetVersion;
354 Property System:String read GetSystem;
355 Published
356 Property Password:String read GetPassWord write SetPassWord;
357 Property RemoteHost:String read GetRemoteHost write SetRemoteHost;
358 Property RemoteAccount:String read GetRemoteAccount write SetRemoteAccount;
359 Property UserId:String read GetUserId write SetUserId;
360 Property RemoteDirName:String read GetRemoteDirName write SetRemoteDirName;
361 Property TransferMode:TFTPTransferMode read FTransferMode write FTransferMode;
362
363 Property OnTransferProgress:TFTPOnTransferProgress read FOnTransferProgress write FOnTransferProgress;
364 Property OnError:TOnFTPError read FOnError write FOnError;
365 End;
366
367 TTCPError=Procedure(Sender:TObject;ErrNumber:LongInt;Const Description:String) Of Object;
368 TTCPConnectionRequest=Procedure(Sender:TObject;PortID:LongInt;Const IP:String) Of Object;
369
370 TTCPState=(sckClosed,sckListening,sckConnected,sckError);
371
372//TTCP Error codes
373Const
374 SOCBASEERR =10000;
375
376 /* OS/2 SOCKET API definitions */
377 SOCEPERM =SOCBASEERR+1; /* Not owner */
378 SOCESRCH =SOCBASEERR+3; /* No such process */
379 SOCEINTR =SOCBASEERR+4; /* Interrupted system call */
380 SOCENXIO =SOCBASEERR+6; /* No such device or address */
381 SOCEBADF =SOCBASEERR+9; /* Bad file number */
382 SOCEACCES =SOCBASEERR+13; /* Permission denied */
383 SOCEFAULT =SOCBASEERR+14; /* Bad address */
384 SOCEINVAL =SOCBASEERR+22; /* Invalid argument */
385 SOCEMFILE =SOCBASEERR+24; /* Too many open files */
386 SOCEPIPE =SOCBASEERR+32; /* Broken pipe */
387
388 SOCEOS2ERR =SOCBASEERR+100; /* OS/2 Error */
389
390 /* OS/2 SOCKET API definitions of regular BSD error constants */
391 SOCEWOULDBLOCK =SOCBASEERR+35; /* Operation would block */
392 SOCEINPROGRESS =SOCBASEERR+36; /* Operation now in progress */
393 SOCEALREADY =SOCBASEERR+37; /* Operation already in progress */
394 SOCENOTSOCK =SOCBASEERR+38; /* Socket operation on non-socket */
395 SOCEDESTADDRREQ =SOCBASEERR+39; /* Destination address required */
396 SOCEMSGSIZE =SOCBASEERR+40; /* Message too long */
397 SOCEPROTOTYPE =SOCBASEERR+41; /* Protocol wrong type for socket */
398 SOCENOPROTOOPT =SOCBASEERR+42; /* Protocol not available */
399 SOCEPROTONOSUPPORT =SOCBASEERR+43; /* Protocol not supported */
400 SOCESOCKTNOSUPPORT =SOCBASEERR+44; /* Socket type not supported */
401 SOCEOPNOTSUPP =SOCBASEERR+45; /* Operation not supported on socket */
402 SOCEPFNOSUPPORT =SOCBASEERR+46; /* Protocol family not supported */
403 SOCEAFNOSUPPORT =SOCBASEERR+47; /* Address family not supported by protocol family */
404 SOCEADDRINUSE =SOCBASEERR+48; /* Address already in use */
405 SOCEADDRNOTAVAIL =SOCBASEERR+49; /* Can't assign requested address */
406 SOCENETDOWN =SOCBASEERR+50; /* Network is down */
407 SOCENETUNREACH =SOCBASEERR+51; /* Network is unreachable */
408 SOCENETRESET =SOCBASEERR+52; /* Network dropped connection on reset */
409 SOCECONNABORTED =SOCBASEERR+53; /* Software caused connection abort */
410 SOCECONNRESET =SOCBASEERR+54; /* Connection reset by peer */
411 SOCENOBUFS =SOCBASEERR+55; /* No buffer space available */
412 SOCEISCONN =SOCBASEERR+56; /* Socket is already connected */
413 SOCENOTCONN =SOCBASEERR+57; /* Socket is not connected */
414 SOCESHUTDOWN =SOCBASEERR+58; /* Can't send after socket shutdown */
415 SOCETOOMANYREFS =SOCBASEERR+59; /* Too many references: can't splice */
416 SOCETIMEDOUT =SOCBASEERR+60; /* Connection timed out */
417 SOCECONNREFUSED =SOCBASEERR+61; /* Connection refused */
418 SOCELOOP =SOCBASEERR+62; /* Too many levels of symbolic links */
419 SOCENAMETOOLONG =SOCBASEERR+63; /* File name too long */
420 SOCEHOSTDOWN =SOCBASEERR+64; /* Host is down */
421 SOCEHOSTUNREACH =SOCBASEERR+65; /* No route to host */
422 SOCENOTEMPTY =SOCBASEERR+66; /* Directory not empty */
423
424Type
425 TTCP = Class(TComponent)
426 Private
427 FInSocket:LongInt;
428 FOutSocket:LongInt;
429 FAcceptSocket:LongInt;
430 FOnError:TTCPError;
431 FOnConnect:TNotifyEvent;
432 FOnConnectionRequest:TTCPConnectionRequest;
433 FOnClose:TNotifyEvent;
434 FOnSendComplete:TNotifyEvent;
435 FQueueLength:LongInt;
436 FLocalAddress:LongWord;
437 FDLLHandle:LongWord;
438 FTCPDLLHandle:LongWord;
439 FErrorCode:LongInt;
440 FLocalPort:LongInt;
441 FSockMode:LongWord;
442 FConnected:Boolean;
443 FState:TTCPState;
444
445 FAccept:Function(p1:LONGINT;VAR sa;var p2:LONGINT):LongInt;APIENTRY;
446 FSock_Init:Function:LongInt;APIENTRY;
447 FSoClose:Function(p1:LongInt):LongInt;APIENTRY;
448 FINet_Addr:Function(Const c:CSTRING):LongWord;APIENTRY;
449 FBind:Function(p1:LongInt;Var sa;p2:LongInt):LongInt;APIENTRY;
450 FConnect:Function(p1:LongInt;Var sa;p2:LongInt):LongInt;APIENTRY;
451 FGethostname:Function(Var C:CString;Len:LongWord):LongInt;APIENTRY;
452 FGethostid:Function:LongInt;APIENTRY;
453 FGetpeername:Function(p1:LongInt;Var sa;Var p2:LongInt):LongInt;APIENTRY;
454 FGetsockname:Function(p1:LongInt;Var sa;Var p2:LongInt):LongInt;APIENTRY;
455 FGetsockopt:Function(p1,p2,p3:LongInt;Var c:CString;Var p4:LongInt):LongInt;APIENTRY;
456 Fioctl:Function(p1,p2:LongInt;Var c:CString;p3:LongInt):LongInt;APIENTRY;
457 FListen:Function(p1,p2:LongInt):LongInt;APIENTRY;
458 Frecvmsg:Function(p1:LongInt;Var mh;p2:LongInt):LongInt;APIENTRY;
459 Frecv:Function(p1:LongInt;Var c;p2,p3:LongInt):LongInt;APIENTRY;
460 Frecvfrom:Function(p1:LongInt;Var c;p2,p3:LongInt;Var sa;
461 Var p4:LongInt):LongInt;APIENTRY;
462 Fselect:Function(Var p1:LongInt;p2,p3,p4,p5:LongInt):LongInt;APIENTRY;
463 Fsend:Function(p1:LONGINT;VAR c;p2,p3:LONGINT):LONGINT;APIENTRY;
464 Fsendmsg:Function(p1:LongInt;Var mh;p2:LongInt):LongInt;APIENTRY;
465 Fsendto:Function(p1:LongInt;Var c;p2,p3:LongInt;
466 Var sa;p4:LongInt):LongInt;APIENTRY;
467 Fsetsockopt:Function(p1,p2,p3:LongInt;Var c:CString;p4:LongInt):LongInt;APIENTRY;
468 Fsock_errno:Function:LongInt;APIENTRY;
469 Fpsock_errno:Function(Const c:CString):LongInt;APIENTRY;
470 FSocket:Function(p1,p2,p3:LongInt):LongInt;APIENTRY;
471 Fsoabort:Function(p1:LongInt):LongInt;APIENTRY;
472 Fso_cancel:Function(p1:LongInt):LongInt;APIENTRY;
473 Freadv:Function(p1:LongInt;Var io;p2:LongInt):LongInt;APIENTRY;
474 Fwritev:Function(p1:LongInt;Var io;p2:LongInt):LongInt;APIENTRY;
475 Fshutdown:Function(p1,p2:LongInt):LongInt;APIENTRY;
476 Fgetinetversion:Function(Var c:CString):LongInt;APIENTRY;
477 FBswap:Function(p:Word):Word;APIENTRY;
478 Fgethostbyname:Function(Const c:CString):Pointer;APIENTRY;
479 Private
480 Function GetLocalHostName:String;
481 Function GetLocalIP:String;
482 Function GetLocalPort:LongInt;
483 Procedure SetLocalPort(NewValue:LongInt);
484 Protected
485 Procedure SetupComponent;Override;
486 Public
487 Procedure Connect(Const RemoteHost:String;RemotePort:LongInt);
488 Procedure Listen;
489 Procedure Accept(Var PortID:LongInt;Var IP:String);
490 Procedure SendData(Var Buf;BufLen:LongInt);
491 Procedure GetData(Var Buf;MaxLen:LongInt;Var Received:LongInt);
492 Procedure PeekData(Var Buf;MaxLen:LongInt;Var Received:LongInt);
493 Procedure Close;
494 Destructor Destroy;Override;
495 Procedure TCPError(Code:LongInt);Virtual;
496 Public
497 Property LocalHostName:String read GetLocalHostName;
498 Property LocalIP:String read GetLocalIP;
499 Property InSocketHandle:LongInt read FInSocket;
500 Property OutSocketHandle:LongInt read FOutSocket;
501 Property AcceptSocketHandle:LongInt read FAcceptSocket;
502 Function INetAddressFromName(Const Name:String):LongWord;
503 Property ErrorCode:LongInt read FErrorCode;
504 Property Connected:Boolean read FConnected;
505 Property State:TTCPState read FState;
506 Published
507 Property LocalPort:LongInt read GetLocalPort write SetLocalPort;
508 Property QueueLength:LongInt read FQueueLength write FQueueLength;
509 Property LocalAddress:LongWord read FLocalAddress write FLocalAddress;
510
511 Property OnError:TTCPError read FOnError write FOnError;
512 Property OnConnect:TNotifyEvent read FOnConnect write FOnConnect;
513 Property OnConnectionRequest:TTCPConnectionRequest read FOnConnectionRequest write FOnConnectionRequest;
514 Property OnClose:TNotifyEvent read FOnClose write FOnClose;
515 Property OnSendComplete:TNotifyEvent read FOnSendComplete write FOnSendComplete;
516 End;
517
518 TUDP=Class(TTCP)
519 Protected
520 Procedure SetupComponent;Override;
521 Public
522 Procedure SendTo(Const RemoteHost:String;RemotePort:LongInt;
523 Var Buf;BufLen:LongInt);
524 Procedure ReceiveFrom(Const RemoteHost:String;RemotePort:LongInt;
525 Var Buf;BufLen:LongWord);
526 End;
527
528Implementation
529
530{
531ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
532º º
533º Speed-Pascal/2 Version 2.0 º
534º º
535º Speed-Pascal Component Classes (SPCC) º
536º º
537º This section: THTTPBrowser Class Implementation º
538º º
539º Last Modified: September 1995 º
540º º
541º (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited ! º
542º º
543ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
544}
545
546
547Type
548 EProcAddrError=Class(Exception);
549
550Const
551 WC_WXVIEW:Cstring[9]='WXViewWC';
552
553Const
554 WX_ERROR = -1;
555 WX_SUCCESS = 0;
556 WX_CANCELLED = 1;
557
558Type
559 WXFONTSIZE = LongWord;
560
561Const
562 WXFONT_SMALL = 0;
563 WXFONT_NORMAL = 1;
564 WXFONT_LARGE = 2;
565 WXFONT_XLARGE = 3;
566
567 WXSMALLSTRING = 32;
568 WXMEDSTRING = 256;
569 WXLARGESTRING = 1024;
570
571 WXGATEWAY_NONE = 0;
572 WXGATEWAY_PROXY = 1; /* gateway flags can be OR'ed */
573 WXGATEWAY_SOCKS = 2;
574
575 WXSEARCH_FORWARD = 0;
576 WXSEARCH_BACKWARD = 1;
577
578 WXANCHOR_DEFAULT = 0; /* can be OR'ed together */
579 WXANCHOR_VISITED = 1;
580
581 WM_FTPAPI_XFER_UPDATE = WM_USER + 1000;
582
583Type
584 PWXDISPLAYOPTS = ^WXDISPLAYOPTS;
585 WXDISPLAYOPTS = Record
586 szFontName: cstring[WXSMALLSTRING-1];
587 wxFontSize: WXFONTSIZE;
588 bUnderlineAnchors: BOOL; /* use underline text for links */
589
590 lClrText: LONG; /* text color */
591 lClrAnchor: LONG; /* link color */
592 lClrVisitedAnchor: LONG ; /* seen link color */
593 lClrBackground: LONG ; /* bg view color */
594
595 bInlineGraphics: BOOL; /* show inline images? */
596 bFastLoad: BOOL; /* load document ahead of images? */
597 bStreamingGraphics: BOOL; /* scanline-at-a-time redraw? */
598 bFancyInterlace: BOOL; /* blur the ilaced GIF? */
599
600 bInternalViewer: BOOL; /* view standalone imgs in view? */
601 bIgnoreImgErrors: BOOL; /* toggle display of red "X" on error */
602 End;
603
604 WXVIEWER = Record
605 szMIMEType: CString[WXMEDSTRING-1]; /* MIME type to be viewed */
606 szProgram: CString[WXLARGESTRING-1]; /* program to use as a viewer */
607 End;
608 PWXVIEWER = ^WXVIEWER;
609
610 WXGATEWAY = ULONG;
611
612 WXNETWORKOPTS = Record
613 szEmailAddress: CString[WXLARGESTRING-1]; /* user@host smtp style address */
614 szNewsServer: CString[WXLARGESTRING-1]; /* news hostname/ip address */
615 wxGateway: WXGATEWAY; /* proxy or socks server state */
616 szHTTPProxyServer: CString[WXLARGESTRING-1]; /* proxy gw (http://..) */
617 szSocksServer: CString[WXLARGESTRING-1]; /* socks gw hostname/ip address */
618 End;
619 PWXNETWORKOPTS = ^WXNETWORKOPTS;
620
621 WXCACHEOPTS = Record
622 bEnabled: BOOL; /* enable, disable cacheing */
623 bMemoryImageCacheing: BOOL; /* keep cached images in memory */
624 lDocLimit: LONG; /* number of docs to cache */
625 lImageLimit: LONG; /* number of images to cache */
626 szCacheDir: Cstring[WXMEDSTRING-1]; /* directory for cacheing to disk */
627 End;
628 PWXCACHEOPTS = ^WXCACHEOPTS;
629
630 WXFLAGS = ULONG;
631
632 WXBUTTONDATA = Record
633 usButtonNum: USHORT;
634 usClickNum: USHORT;
635 x: SHORT;
636 y: SHORT;
637 fsHitTestRes: USHORT;
638 fsFlags: USHORT;
639 wxflPosType: WXFLAGS;
640 End;
641 PWXBUTTONDATA = ^WXBUTTONDATA;
642
643 WXMOUSEDATA = Record
644 x: USHORT;
645 y: USHORT;
646 uswHitTest: USHORT;
647 fsFlags: USHORT;
648 wxflPosType: WXFLAGS;
649 end;
650 PWXMOUSEDATA = ^WXMOUSEDATA;
651
652
653Function GetProcAddr(DllHandle:LongWord;Const ProcName:String):Pointer;
654Var S:cstring;
655Begin
656 S:=ProcName;
657 {$IFDEF OS2}
658 If DosQueryProcAddr(DllHandle,0,S,Result)<>0 Then Raise EProcAddrError.Create(ProcName);
659 {$ENDIF}
660 {$IFDEF Win95}
661 Result:=GetProcAddress(DllHandle,S);
662 If Result=Nil Then Raise EProcAddrError.Create(ProcName);
663 {$ENDIF}
664End;
665
666Procedure THTTPBrowser.GetClassData(Var ClassData:TClassData);
667Begin
668 Inherited GetClassData(ClassData);
669 If FDLLHandle<>0 Then
670 Begin
671 ClassData.ClassULong:=0;
672 ClassData.ClassName:=WC_WXVIEW;
673 OwnerDraw:=False;
674 End;
675End;
676
677Function THTTPBrowser.GetVersion:Word;
678Begin
679 If FDLLHandle<>0 Then Result:=FWXViewQueryVersion
680 Else Result:=0;
681End;
682
683Procedure THTTPBrowser.SetupShow;
684Var Opts: WXDISPLAYOPTS;
685Begin
686 Inherited SetupShow;
687
688 If FDLLHandle<>0 Then
689 Begin
690 If not FHTTPFontSizeAssigned Then
691 Begin
692 FWXViewQueryDisplayOpts(Handle,Opts,SizeOf(Opts));
693 Opts.WXFontSize := WXFONT_SMALL;
694 FWXViewSetDisplayOpts(Handle,Opts,SizeOf(Opts));
695 End;
696
697 If FInlineGraphicsAssigned Then InlineGraphics:=FInlineGraphics;
698 If FUnderlineAnchorsAssigned Then UnderlineAnchors:=FUnderlineAnchors;
699 If FHTTPFontSizeAssigned Then HTTPFontSize:=FHTTPFontSize;
700 If FEmailAddress<>Nil Then
701 Begin
702 EmailAddress:=FEmailAddress^;
703 FreeMem(FEmailAddress,length(FEmailAddress^)+1);
704 FEmailAddress:=Nil;
705 End;
706 If FNewsServer<>Nil Then
707 Begin
708 NewsServer:=FNewsServer^;
709 FreeMem(FNewsServer,length(FNewsServer^)+1);
710 FNewsServer:=Nil;
711 End;
712 If FProxyServer<>Nil Then
713 Begin
714 ProxyServer:=FProxyServer^;
715 FreeMem(FProxyServer,length(FProxyServer^)+1);
716 FProxyServer:=Nil;
717 End;
718 If FSocksServer<>Nil Then
719 Begin
720 SocksServer:=FSocksServer^;
721 FreeMem(FSocksServer,length(FSocksServer^)+1);
722 FSocksServer:=Nil;
723 End;
724 If FGatewayAssigned Then Gateway:=FGateway;
725 If FEnableCacheAssigned Then EnableCache:=FEnableCache;
726 If FCacheDocLimitAssigned Then CacheDocLimit:=FCacheDocLimit;
727 If FCacheImageLimitAssigned Then CacheImageLimit:=FCacheImageLimit;
728 If FCacheDir<>Nil Then
729 Begin
730 CacheDir:=FCacheDir^;
731 FreeMem(FCacheDir,length(FCacheDir^)+1);
732 FCacheDir:=Nil;
733 End;
734 End;
735End;
736
737Function THTTPBrowser.GetURL:String;
738Begin
739 If FURL<>Nil Then Result:=FURL^
740 Else Result:='';
741End;
742
743Procedure THTTPBrowser.SetURL(NewValue:String);
744Begin
745 If FDLLHandle=0 Then exit;
746
747 If FURL<>Nil Then FreeMem(FURL,length(FURL^)+1);
748 GetMem(FURL,length(NewValue)+1);
749 FURL^:=NewValue;
750 If Loaded Then Load;
751End;
752
753Procedure THTTPBrowser.Load;
754Var C:CString;
755Begin
756 If FDLLHandle<>0 Then If Handle<>0 Then If URL<>'' Then
757 Begin
758 C:=FURL^;
759 If FWXViewLoad(Handle,@C,0,Nil)<>WX_SUCCESS Then
760 If FOnLoad<>Nil Then FOnLoad(Self,httpLoadError);;
761 End;
762End;
763
764Procedure THTTPBrowser.LoadWithAnchor(Var Anchor);
765Var C:CString;
766Begin
767 If FDLLHandle<>0 Then If Handle<>0 Then If URL<>'' Then
768 Begin
769 C:=FURL^;
770 If FWXViewLoad(Handle,@C,0,Anchor)<>WX_SUCCESS Then
771 If FOnLoad<>Nil Then FOnLoad(Self,httpLoadError);
772 End;
773End;
774
775Function THTTPBrowser.LoadToFile(Const FileName:String):Boolean;
776Var C,C1:CString;
777Begin
778 Result:=False;
779 If FDLLHandle<>0 Then If Handle<>0 Then If URL<>'' Then
780 Begin
781 C:=FURL^;
782 C1:=FileName;
783 Result:=FWXViewLoadToFile(Handle,@C,@C1,0,Nil)=WX_SUCCESS;
784 If not Result Then
785 If FOnLoad<>Nil Then FOnLoad(Self,httpLoadError);
786 End;
787End;
788
789Function THTTPBrowser.LoadToFileWithAnchor(Const FileName:String;Var Anchor):Boolean;
790Var C,C1:CString;
791Begin
792 Result:=False;
793 If FDLLHandle<>0 Then If Handle<>0 Then If URL<>'' Then
794 Begin
795 C:=FURL^;
796 C1:=FileName;
797 Result:=FWXViewLoadToFile(Handle,@C,@C1,0,Anchor)=WX_SUCCESS;
798 If not Result Then
799 If FOnLoad<>Nil Then FOnLoad(Self,httpLoadError);
800 End;
801End;
802
803
804Procedure THTTPBrowser.CancelLoad;
805Begin
806 If FDLLHandle<>0 Then If Handle<>0 Then
807 Begin
808 FLoadCancel:=False;
809 If FWXViewCancelLoad(Handle)<>WX_ERROR Then
810 Begin
811 //wait for the cancel operation to complete
812 Repeat
813 Application.HandleMessage;
814 Until FLoadCancel;
815 End;
816 End;
817End;
818
819Procedure THTTPBrowser.SetupComponent;
820Var C,DllName:CString;
821Begin
822 Inherited SetupComponent;
823 Name:='HTTP';
824 Width:=300;
825 Height:=300;
826
827 DllName:='WEBEXWIN';
828 {$IFDEF OS2}
829 If DosLoadModule(C,255,DllName,FDllHandle)<>0 Then
830 Begin
831 FDLLHandle:=0;
832 If ComponentState * [csWriting,csDesigning] = []
833 Then ErrorBox('DLL not found: WEBEXWIN.DLL !');
834 Exit;
835 End;
836 {$ENDIF}
837 {$IFDEF WIN32}
838 If ComponentState * [csWriting,csDesigning] = []
839 Then ErrorBox('THTTPBrowser currently not supported for Win32 !');
840 Exit;
841 {$ENDIF}
842
843 Try
844 FWXViewQueryVersion:=Pointer(GetProcAddr(FDllHandle,'WXViewQueryVersion'));
845 FWXViewQueryDisplayOpts:=Pointer(GetProcAddr(FDllHandle,'WXViewQueryDisplayOpts'));
846 FWXViewSetDisplayOpts:=Pointer(GetProcAddr(FDllHandle,'WXViewSetDisplayOpts'));
847 FWXViewLoad:=Pointer(GetProcAddr(FDllHandle,'WXViewLoad'));
848 FWXViewQueryViewer:=(GetProcAddr(FDllHandle,'WXViewQueryViewer'));
849 FWXViewSetViewer:=(GetProcAddr(FDllHandle,'WXViewSetViewer'));
850 FWXViewQueryNetworkOpts:=(GetProcAddr(FDllHandle,'WXViewQueryNetworkOpts'));
851 FWXViewSetNetworkOpts:=(GetProcAddr(FDllHandle,'WXViewSetNetworkOpts'));
852 FWXViewEnableGateway:=(GetProcAddr(FDllHandle,'WXViewEnableGateway'));
853 FWXViewQueryCacheOpts:=(GetProcAddr(FDllHandle,'WXViewQueryCacheOpts'));
854 FWXViewSetCacheOpts:=(GetProcAddr(FDllHandle,'WXViewSetCacheOpts'));
855 FWXViewCancelLoad:=(GetProcAddr(FDllHandle,'WXViewCancelLoad'));
856 FWXViewQueryDocTitle:=(GetProcAddr(FDllHandle,'WXViewQueryDocTitle'));
857 FWXViewQueryAnchorData:=(GetProcAddr(FDllHandle,'WXViewQueryAnchorData'));
858 FWXViewQueryAnchorDataLen:=(GetProcAddr(FDllHandle,'WXViewQueryAnchorDataLen'));
859 FWXViewQueryAnchor:=(GetProcAddr(FDllHandle,'WXViewQueryAnchor'));
860 FWXViewQueryPos:=(GetProcAddr(FDllHandle,'WXViewQueryPos'));
861 FWXViewLoadToFile:=(GetProcAddr(FDllHandle,'WXViewLoadToFile'));
862 FWXViewQueryDocAnchor:=(GetProcAddr(FDllHandle,'WXViewQueryDocAnchor'));
863 FWXViewSearch:=(GetProcAddr(FDllHandle,'WXViewSearch'));
864 FWXViewIsLoading:=(GetProcAddr(FDllHandle,'WXViewIsLoading'));
865 FWXViewQueryAnchorState:=(GetProcAddr(FDllHandle,'WXViewQueryAnchorState'));
866 FWXViewSetAnchorState:=(GetProcAddr(FDllHandle,'WXViewSetAnchorState'));
867 FWXViewQueryLastError:=(GetProcAddr(FDllHandle,'WXViewQueryLastError'));
868 FWXViewQueryLastLoadError:=(GetProcAddr(FDllHandle,'WXViewQueryLastLoadError'));
869
870 FWXViewQueryVersion; //Initialize and load window class
871 Except
872 {$IFDEF OS2}
873 DosFreeModule(FDLLHandle);
874 {$ENDIF}
875 FDLLHandle:=0;
876 On E:EProcAddrError Do
877 Begin
878 If ComponentState * [csWriting,csDesigning] = []
879 Then ErrorBox('Cannot retrieve procedure from WEBEXWIN:'+E.Message+' !');
880 End;
881 Else Raise;
882 End;
883End;
884
885Destructor THTTPBrowser.Destroy;
886Begin
887 If FDLLHandle<>0 Then
888 Begin
889 {$IFDEF OS2}
890 DosFreeModule(FDLLHandle);
891 {$ENDIF}
892 FDLLHandle:=0;
893 End;
894 If FURL<>Nil Then
895 Begin
896 FreeMem(FURL,length(FURL^)+1);
897 FURL:=Nil;
898 End;
899
900 If FEmailAddress<>Nil Then
901 Begin
902 FreeMem(FEmailAddress,length(FEmailAddress^)+1);
903 FEmailAddress:=Nil;
904 End;
905 If FNewsServer<>Nil Then
906 Begin
907 FreeMem(FNewsServer,length(FNewsServer^)+1);
908 FNewsServer:=Nil;
909 End;
910 If FProxyServer<>Nil Then
911 Begin
912 FreeMem(FProxyServer,length(FProxyServer^)+1);
913 FProxyServer:=Nil;
914 End;
915 If FSocksServer<>Nil Then
916 Begin
917 FreeMem(FSocksServer,length(FSocksServer^)+1);
918 FSocksServer:=Nil;
919 End;
920 If FCacheDir<>Nil Then
921 Begin
922 FreeMem(FCacheDir,length(FCacheDir^)+1);
923 FCacheDir:=Nil;
924 End;
925
926 Inherited Destroy;
927End;
928
929Function THTTPBrowser.GetInlineGraphics:Boolean;
930Var Opts: WXDISPLAYOPTS;
931Begin
932 If FDLLHandle=0 Then exit;
933 If Handle=0 Then
934 Begin
935 If FInlineGraphicsAssigned Then result:=FInlineGraphics
936 Else Result:=False;
937 exit
938 End;
939 FWXViewQueryDisplayOpts(Handle,Opts,SizeOf(Opts));
940 Result:=Opts.bInlineGraphics;
941End;
942
943Procedure THTTPBrowser.SetInlineGraphics(NewValue:Boolean);
944Var Opts: WXDISPLAYOPTS;
945 RetErr:LongInt;
946Begin
947 If FDLLHandle=0 Then exit;
948 If Handle<>0 Then
949 Begin
950 RetErr:=FWXViewQueryDisplayOpts(Handle,Opts,SizeOf(Opts));
951 If RetErr<>WX_SUCCESS Then exit;
952 Opts.bInlineGraphics:=NewValue;
953 FWXViewSetDisplayOpts(Handle,Opts,SizeOf(Opts));
954 End
955 Else
956 Begin
957 FInlineGraphicsAssigned:=True;
958 FInlineGraphics:=NewValue;
959 End;
960End;
961
962Function THTTPBrowser.GetUnderlineAnchors:Boolean;
963Var Opts: WXDISPLAYOPTS;
964Begin
965 If FDLLHandle=0 Then exit;
966 If Handle=0 Then
967 Begin
968 If FUnderlineAnchorsAssigned Then Result:=FUnderlineAnchors
969 Else Result:=False;
970 exit;
971 End;
972 FWXViewQueryDisplayOpts(Handle,Opts,SizeOf(Opts));
973 Result:=Opts.bUnderlineAnchors;
974End;
975
976Procedure THTTPBrowser.SetUnderlineAnchors(NewValue:Boolean);
977Var Opts: WXDISPLAYOPTS;
978 RetErr:LongInt;
979Begin
980 If FDLLHandle=0 Then exit;
981 If Handle<>0 Then
982 Begin
983 RetErr:=FWXViewQueryDisplayOpts(Handle,Opts,SizeOf(Opts));
984 If RetErr<>WX_SUCCESS Then exit;
985 Opts.bUnderlineAnchors:=NewValue;
986 FWXViewSetDisplayOpts(Handle,Opts,SizeOf(Opts));
987 End
988 Else
989 Begin
990 FUnderlineAnchorsAssigned:=True;
991 FUnderlineAnchors:=NewValue;
992 End;
993End;
994
995Function THTTPBrowser.GetHTTPFontSize:THTTPFontSize;
996Var Opts: WXDISPLAYOPTS;
997Begin
998 Result:=httpFontNormal;
999 If FDLLHandle=0 Then exit;
1000 If Handle=0 Then
1001 Begin
1002 If FHTTPFontSizeAssigned Then result:=FHTTPFontSize
1003 Else Result:=httpFontNormal;
1004 exit;
1005 End;
1006 FWXViewQueryDisplayOpts(Handle,Opts,SizeOf(Opts));
1007 Case Opts.wxFontSize Of
1008 WXFONT_SMALL:Result:=httpFontSmall;
1009 WXFONT_LARGE:Result:=httpFontLarge;
1010 WXFONT_XLARGE:Result:=httpFontXLarge;
1011 Else Result:=httpFontNormal;
1012 End;
1013End;
1014
1015Procedure THTTPBrowser.SetHTTPFontSize(NewValue:THTTPFontSize);
1016Var Opts: WXDISPLAYOPTS;
1017 s:WXFONTSIZE;
1018 RetErr:LongInt;
1019Begin
1020 If FDLLHandle=0 Then exit;
1021 If Handle<>0 Then
1022 Begin
1023 RetErr:=FWXViewQueryDisplayOpts(Handle,Opts,SizeOf(Opts));
1024 If RetErr<>WX_SUCCESS Then exit;
1025 Case NewValue Of
1026 httpFontSmall:s:=WXFONT_SMALL;
1027 httpFontNormal:s:=WXFONT_NORMAL;
1028 httpFontLarge:s:=WXFONT_LARGE;
1029 httpFontXLarge:s:=WXFONT_XLARGE;
1030 End;
1031 Opts.wxFontSize:=s;
1032 FWXViewSetDisplayOpts(Handle,Opts,SizeOf(Opts));
1033 End
1034 Else
1035 Begin
1036 FHTTPFontSizeAssigned:=True;
1037 FHTTPFontSize:=NewValue;
1038 End;
1039End;
1040
1041Function THTTPBrowser.GetMIMEViewer(MIMEPair:String):String;
1042Var Viewer:WXVIEWER;
1043 RetErr:LongInt;
1044 c:CString;
1045Begin
1046 Result:='';
1047 If FDLLHandle=0 Then exit;
1048 If Handle=0 Then exit;
1049 c:=MimePair;
1050 Viewer.szMIMEType:=c;
1051 Viewer.szProgram:='';
1052 RetErr:=FWXViewQueryViewer(Handle,@c,Viewer,sizeof(Viewer));
1053 If RetErr=WX_SUCCESS Then Result:=Viewer.szProgram
1054 Else Result:='';
1055End;
1056
1057Procedure THTTPBrowser.SetMIMEViewer(MIMEPair,EXEProgram:String);
1058Var Viewer:WXVIEWER;
1059Begin
1060 If FDLLHandle=0 Then exit;
1061 If Handle=0 Then exit;
1062 Viewer.szMIMEType:=MIMEPair;
1063 Viewer.szProgram:=ExeProgram;
1064 FWXViewSetViewer(Handle,Viewer,sizeof(Viewer));
1065End;
1066
1067Function THTTPBrowser.GetEmailAddress:String;
1068Var Opts:WXNETWORKOPTS;
1069 RetErr:LongInt;
1070Begin
1071 Result:='';
1072 If FDLLHandle=0 Then exit;
1073 If Handle=0 Then
1074 Begin
1075 If FEmailAddress<>Nil Then Result:=FEmailAddress^
1076 Else Result:='';
1077 exit;
1078 End;
1079 RetErr:=FWXViewQueryNetWorkOpts(Handle,Opts,sizeof(Opts));
1080 If RetErr<>WX_SUCCESS Then exit;
1081 result:=Opts.szEmailAddress;
1082End;
1083
1084Procedure THTTPBrowser.SetEmailAddress(NewValue:String);
1085Var Opts:WXNETWORKOPTS;
1086 RetErr:LongInt;
1087Begin
1088 If FDLLHandle=0 Then exit;
1089 If Handle<>0 Then
1090 Begin
1091 RetErr:=FWXViewQueryNetWorkOpts(Handle,Opts,sizeof(Opts));
1092 If RetErr<>WX_SUCCESS Then exit;
1093 Opts.szEmailAddress:=NewValue;
1094 FWXViewSetNetWorkOpts(Handle,Opts,sizeof(Opts));
1095 End
1096 Else
1097 Begin
1098 GetMem(FEmailAddress,length(NewValue)+1);
1099 FEmailAddress^:=NewValue;
1100 End;
1101End;
1102
1103
1104Function THTTPBrowser.GetNewsServer:String;
1105Var Opts:WXNETWORKOPTS;
1106 RetErr:LongInt;
1107Begin
1108 Result:='';
1109 If FDLLHandle=0 Then exit;
1110 If Handle=0 Then
1111 Begin
1112 If FNewsServer<>Nil Then Result:=FNewsServer^
1113 Else Result:='';
1114 exit;
1115 End;
1116 RetErr:=FWXViewQueryNetWorkOpts(Handle,Opts,sizeof(Opts));
1117 If RetErr<>WX_SUCCESS Then exit;
1118 result:=Opts.szNewsServer;
1119End;
1120
1121Procedure THTTPBrowser.SetNewsServer(NewValue:String);
1122Var Opts:WXNETWORKOPTS;
1123 RetErr:LongInt;
1124Begin
1125 If FDLLHandle=0 Then exit;
1126 If Handle<>0 Then
1127 Begin
1128 RetErr:=FWXViewQueryNetWorkOpts(Handle,Opts,sizeof(Opts));
1129 If RetErr<>WX_SUCCESS Then exit;
1130 Opts.szNewsServer:=NewValue;
1131 FWXViewSetNetWorkOpts(Handle,Opts,sizeof(Opts));
1132 End
1133 Else
1134 Begin
1135 GetMem(FNewsServer,length(NewValue)+1);
1136 FNewsServer^:=NewValue;
1137 End;
1138End;
1139
1140Function THTTPBrowser.GetProxyServer:String;
1141Var Opts:WXNETWORKOPTS;
1142 RetErr:LongInt;
1143Begin
1144 Result:='';
1145 If FDLLHandle=0 Then exit;
1146 If Handle=0 Then
1147 Begin
1148 If FProxyServer<>Nil Then Result:=FProxyServer^
1149 Else Result:='';
1150 exit;
1151 End;
1152 RetErr:=FWXViewQueryNetWorkOpts(Handle,Opts,sizeof(Opts));
1153 If RetErr<>WX_SUCCESS Then exit;
1154 result:=Opts.szHTTPProxyServer;
1155End;
1156
1157Procedure THTTPBrowser.SetProxyServer(NewValue:String);
1158Var Opts:WXNETWORKOPTS;
1159 RetErr:LongInt;
1160Begin
1161 If FDLLHandle=0 Then exit;
1162 If Handle<>0 Then
1163 Begin
1164 RetErr:=FWXViewQueryNetWorkOpts(Handle,Opts,sizeof(Opts));
1165 If RetErr<>WX_SUCCESS Then exit;
1166 Opts.szHTTPProxyServer:=NewValue;
1167 FWXViewSetNetWorkOpts(Handle,Opts,sizeof(Opts));
1168 End
1169 Else
1170 Begin
1171 GetMem(FProxyServer,length(NewValue)+1);
1172 FProxyServer^:=NewValue;
1173 End;
1174End;
1175
1176Function THTTPBrowser.GetSocksServer:String;
1177Var Opts:WXNETWORKOPTS;
1178 RetErr:LongInt;
1179Begin
1180 Result:='';
1181 If FDLLHandle=0 Then exit;
1182 If Handle=0 Then
1183 Begin
1184 If FSocksServer<>Nil Then Result:=FSocksServer^
1185 Else Result:='';
1186 exit;
1187 End;
1188 RetErr:=FWXViewQueryNetWorkOpts(Handle,Opts,sizeof(Opts));
1189 If RetErr<>WX_SUCCESS Then exit;
1190 result:=Opts.szSocksServer;
1191End;
1192
1193Procedure THTTPBrowser.SetSocksServer(NewValue:String);
1194Var Opts:WXNETWORKOPTS;
1195 RetErr:LongInt;
1196Begin
1197 If FDLLHandle=0 Then exit;
1198 If Handle<>0 Then
1199 Begin
1200 RetErr:=FWXViewQueryNetWorkOpts(Handle,Opts,sizeof(Opts));
1201 If RetErr<>WX_SUCCESS Then exit;
1202 Opts.szSocksServer:=NewValue;
1203 FWXViewSetNetWorkOpts(Handle,Opts,sizeof(Opts));
1204 End
1205 Else
1206 Begin
1207 GetMem(FSocksServer,length(NewValue)+1);
1208 FSocksServer^:=NewValue;
1209 End;
1210End;
1211
1212Function THTTPBrowser.GetGateway:THTTPGateway;
1213Var Opts:WXNETWORKOPTS;
1214 RetErr:LongInt;
1215Begin
1216 Result:=httpGatewayNone;
1217 If FDLLHandle=0 Then exit;
1218 If Handle=0 Then
1219 Begin
1220 If FGatewayAssigned Then Result:=FGateway
1221 Else Result:=httpGatewayNone;
1222 exit;
1223 End;
1224 RetErr:=FWXViewQueryNetWorkOpts(Handle,Opts,sizeof(Opts));
1225 If RetErr<>WX_SUCCESS Then exit;
1226 Case Opts.wxGateway Of
1227 WXGATEWAY_PROXY:Result:=httpGatewayProxy;
1228 WXGATEWAY_SOCKS:Result:=httpGatewaySocks;
1229 WXGATEWAY_PROXY Or WXGATEWAY_SOCKS:Result:=httpGatewayProxySocks;
1230 Else Result:=httpGatewayNone;
1231 End;
1232End;
1233
1234Procedure THTTPBrowser.SetGateway(NewValue:THTTPGateway);
1235Var gw:WXGATEWAY;
1236Begin
1237 If FDLLHandle=0 Then exit;
1238 If Handle<>0 Then
1239 Begin
1240 Case NewValue Of
1241 httpGatewayProxy:gw:=WXGATEWAY_PROXY;
1242 httpGatewaySocks:gw:=WXGATEWAY_SOCKS;
1243 httpGatewayProxySocks:gw:=WXGATEWAY_PROXY Or WXGATEWAY_SOCKS;
1244 Else gw:=WXGATEWAY_NONE;
1245 End;
1246 FWXViewEnableGateway(Handle,gw);
1247 End
1248 Else
1249 Begin
1250 FGatewayAssigned:=True;
1251 FGateway:=NewValue;
1252 End;
1253End;
1254
1255Function THTTPBrowser.GetEnableCache:Boolean;
1256Var Opts:WXCACHEOPTS;
1257 RetErr:LongInt;
1258Begin
1259 Result:=False;
1260 If FDLLHandle=0 Then exit;
1261 If Handle=0 Then
1262 Begin
1263 If FEnableCacheAssigned Then Result:=FEnableCache
1264 Else Result:=False;
1265 exit;
1266 End;
1267 RetErr:=FWXViewQueryCacheOpts(Handle,Opts,sizeof(Opts));
1268 If RetErr<>WX_SUCCESS Then exit;
1269 result:=Opts.bEnabled;
1270End;
1271
1272Procedure THTTPBrowser.SetEnableCache(NewValue:Boolean);
1273Var Opts:WXCACHEOPTS;
1274 RetErr:LongInt;
1275Begin
1276 If FDLLHandle=0 Then exit;
1277 If Handle<>0 Then
1278 Begin
1279 RetErr:=FWXViewQueryCacheOpts(Handle,Opts,sizeof(Opts));
1280 If RetErr<>WX_SUCCESS Then exit;
1281 Opts.bEnabled:=NewValue;
1282 FWXViewSetCacheOpts(Handle,Opts,sizeof(Opts));
1283 End
1284 Else
1285 Begin
1286 FEnableCacheAssigned:=True;
1287 FEnableCache:=NewValue;
1288 End;
1289End;
1290
1291Function THTTPBrowser.GetCacheDocLimit:LongInt;
1292Var Opts:WXCACHEOPTS;
1293 RetErr:LongInt;
1294Begin
1295 Result:=0;
1296 If FDLLHandle=0 Then exit;
1297 If Handle=0 Then
1298 Begin
1299 If FCacheDocLimitAssigned Then Result:=FCacheDocLimit
1300 Else Result:=0;
1301 exit;
1302 End;
1303 RetErr:=FWXViewQueryCacheOpts(Handle,Opts,sizeof(Opts));
1304 If RetErr<>WX_SUCCESS Then exit;
1305 result:=Opts.lDocLimit;
1306End;
1307
1308Procedure THTTPBrowser.SetCacheDocLimit(NewValue:LongInt);
1309Var Opts:WXCACHEOPTS;
1310 RetErr:LongInt;
1311Begin
1312 If FDLLHandle=0 Then exit;
1313 If Handle<>0 Then
1314 Begin
1315 RetErr:=FWXViewQueryCacheOpts(Handle,Opts,sizeof(Opts));
1316 If RetErr<>WX_SUCCESS Then exit;
1317 Opts.lDocLimit:=NewValue;
1318 FWXViewSetCacheOpts(Handle,Opts,sizeof(Opts));
1319 End
1320 Else
1321 Begin
1322 FCacheDocLimitAssigned:=True;
1323 FCacheDocLimit:=NewValue;
1324 End;
1325End;
1326
1327Function THTTPBrowser.GetCacheImageLimit:LongInt;
1328Var Opts:WXCACHEOPTS;
1329 RetErr:LongInt;
1330Begin
1331 Result:=0;
1332 If FDLLHandle=0 Then exit;
1333 If Handle=0 Then
1334 Begin
1335 If FCacheImageLimitAssigned Then Result:=FCacheImageLimit
1336 Else Result:=0;
1337 exit;
1338 End;
1339 RetErr:=FWXViewQueryCacheOpts(Handle,Opts,sizeof(Opts));
1340 If RetErr<>WX_SUCCESS Then exit;
1341 result:=Opts.lImageLimit;
1342End;
1343
1344Procedure THTTPBrowser.SetCacheImageLimit(NewValue:LongInt);
1345Var Opts:WXCACHEOPTS;
1346 RetErr:LongInt;
1347Begin
1348 If FDLLHandle=0 Then exit;
1349 If Handle<>0 Then
1350 Begin
1351 RetErr:=FWXViewQueryCacheOpts(Handle,Opts,sizeof(Opts));
1352 If RetErr<>WX_SUCCESS Then exit;
1353 Opts.lImageLimit:=NewValue;
1354 FWXViewSetCacheOpts(Handle,Opts,sizeof(Opts));
1355 End
1356 Else
1357 Begin
1358 FCacheImageLimitAssigned:=True;
1359 FCacheImageLimit:=NewValue;
1360 End;
1361End;
1362
1363Function THTTPBrowser.GetCacheDir:String;
1364Var Opts:WXCACHEOPTS;
1365 RetErr:LongInt;
1366Begin
1367 Result:='';
1368 If FDLLHandle=0 Then exit;
1369 If Handle=0 Then
1370 Begin
1371 If FCacheDir<>Nil Then Result:=FCacheDir^
1372 Else Result:='';
1373 exit;
1374 End;
1375 RetErr:=FWXViewQueryCacheOpts(Handle,Opts,sizeof(Opts));
1376 If RetErr<>WX_SUCCESS Then exit;
1377 result:=Opts.szCacheDir;
1378End;
1379
1380Procedure THTTPBrowser.SetCacheDir(NewValue:String);
1381Var Opts:WXCACHEOPTS;
1382 RetErr:LongInt;
1383Begin
1384 If FDLLHandle=0 Then exit;
1385 If Handle<>0 Then
1386 Begin
1387 RetErr:=FWXViewQueryCacheOpts(Handle,Opts,sizeof(Opts));
1388 If RetErr<>WX_SUCCESS Then exit;
1389 Opts.szCacheDir:=NewValue;
1390 FWXViewSetCacheOpts(Handle,Opts,sizeof(Opts));
1391 End
1392 Else
1393 Begin
1394 GetMem(FCacheDir,length(NewValue)+1);
1395 FCacheDir^:=NewValue;
1396 End;
1397End;
1398
1399Procedure THTTPBrowser.SetLoaded(NewValue:Boolean);
1400Begin
1401 If NewValue Then Load
1402 Else CancelLoad;
1403End;
1404
1405Procedure THTTPBrowser.WXLoadResult(Var Msg:TMessage);
1406Var s:THTTPLoadStatus;
1407Begin
1408 FLoaded:=Msg.Param2=WX_SUCCESS;
1409 Case Msg.Param2 Of
1410 WX_SUCCESS:s:=httpLoadSuccess;
1411 WX_CANCELLED:s:=httpLoadCancelled;
1412 Else s:=httpLoadError;
1413 End;
1414 If FOnLoad<>Nil Then FOnLoad(Self,s);
1415 FLoadCancel:=True; //indicate message received
1416End;
1417
1418Function THTTPBrowser.GetDocTitle:String;
1419Var C:CString;
1420Begin
1421 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1422 If FWXViewQueryDocTitle(Handle,@c,250)<>WX_SUCCESS Then Result:=''
1423 Else Result:=c;
1424End;
1425
1426Function THTTPBrowser.GetAnchorDataLen(Const Pos:THTTPPos):LongWord;
1427Begin
1428 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1429 Result:=FWXViewQueryAnchorDataLen(Handle,Pos);
1430End;
1431
1432Function THTTPBrowser.GetAnchorData(Const Pos:THTTPPos;Var Buf;BufLen:LongWord):Boolean;
1433Begin
1434 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1435 Result:=FWXViewQueryAnchorData(Handle,Pos,Buf,BufLen)=WX_SUCCESS;
1436End;
1437
1438Function THTTPBrowser.GetAnchor(Const Pos:THTTPPos):String;
1439Var c:CString;
1440Begin
1441 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1442 If FWXViewQueryAnchor(Handle,Pos,@c,250)=WX_SUCCESS Then Result:=c
1443 Else Result:='';
1444End;
1445
1446Procedure THTTPBrowser.WXButtonClick(Var Msg:TMessage);
1447Var BData:PWXBUTTONDATA;
1448 Pos:THTTPPos;
1449Begin
1450 BData:=Pointer(Msg.Param2);
1451 If BData<>Nil Then If BData^.usButtonNum=1 Then //only for left button
1452 Begin
1453 If FWXViewQueryPos(Handle,BData^.x,BData^.y,Pos)=WX_SUCCESS Then
1454 If FOnDocMouseClick<>Nil Then FOnDocMouseClick(Self,Pos);
1455 End;
1456End;
1457
1458Procedure THTTPBrowser.WXMouseMove(Var Msg:TMessage);
1459Var MData:PWXMOUSEDATA;
1460 Pos:THTTPPos;
1461Begin
1462 MData:=Pointer(Msg.Param2);
1463 If MData<>Nil Then
1464 Begin
1465 If FWXViewQueryPos(Handle,MData^.x,MData^.y,Pos)=WX_SUCCESS Then
1466 If FOnDocMouseMove<>Nil Then FOnDocMouseMove(Self,Pos);
1467 End;
1468End;
1469
1470Function THTTPBrowser.GetDocAnchor:String;
1471Var c:CString;
1472Begin
1473 Result:='';
1474 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1475 If FWXViewQueryDocAnchor(Handle,@c,250)=WX_SUCCESS Then Result:=C;
1476End;
1477
1478Function THTTPBrowser.Search(Const s:String;Const StartPos:THTTPPos;Options:THTTPSearchOptions):THTTPPos;
1479Var Opt:LongWord;
1480 C:CString;
1481Begin
1482 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1483 C:=s;
1484 If Options=httpSearchBackward Then Opt:=WXSEARCH_BACKWARD
1485 Else Opt:=WXSEARCH_FORWARD;
1486 If FWXViewSearch(Handle,Opt,StartPos,Result,@C)<>WX_SUCCESS Then
1487 FillChar(Result,sizeof(Result),0);
1488End;
1489
1490Function THTTPBrowser.GetIsLoading:Boolean;
1491Begin
1492 Result:=False;
1493 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1494 Result:=FWXViewIsLoading(Handle);
1495End;
1496
1497Function THTTPBrowser.GetAnchorState(Const Anchor:String):THTTPAnchorState;
1498Var C:CString;
1499 S:LongWord;
1500Begin
1501 result:=httpAnchorDefault;
1502 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1503 C:=Anchor;
1504 If FWXViewQueryAnchorState(Handle,@C,s)=WX_SUCCESS Then
1505 Begin
1506 If s=WXANCHOR_VISITED Then Result:=httpAnchorVisited
1507 Else result:=httpAnchorDefault;
1508 End;
1509End;
1510
1511Procedure THTTPBrowser.SetAnchorState(Const Anchor:String;NewValue:THTTPAnchorState);
1512Var S:LongWord;
1513 C:CString;
1514Begin
1515 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1516 C:=Anchor;
1517 If NewValue=httpAnchorVisited Then s:=WXANCHOR_VISITED
1518 Else s:=WXANCHOR_DEFAULT;
1519 FWXViewSetAnchorState(Handle,@C,s);
1520End;
1521
1522Function THTTPBrowser.GetLastLoadError:LongInt;
1523Begin
1524 Result:=0;
1525 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1526 Result:=FWXViewQueryLastLoadError(Handle);
1527End;
1528
1529Function THTTPBrowser.GetLastError:LongInt;
1530Begin
1531 Result:=0;
1532 If ((FDLLHandle=0)Or(Handle=0)) Then exit;
1533 Result:=FWXViewQueryLastError(Handle);
1534End;
1535
1536{
1537ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
1538º º
1539º Speed-Pascal/2 Version 2.0 º
1540º º
1541º Speed-Pascal Component Classes (SPCC) º
1542º º
1543º This section: TFTP Class Implementation º
1544º º
1545º Last Modified: September 1995 º
1546º º
1547º (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited ! º
1548º º
1549ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
1550}
1551
1552
1553Type
1554 TFTPNotifyControl=Class(TControl)
1555 Private
1556 FFTP:TFTP;
1557 Protected
1558 Procedure SetupComponent;Override;
1559 Procedure CreateWnd;Override;
1560 Procedure WMFTPUpdate(Var Msg:TMessage); message WM_FTPAPI_XFER_UPDATE;
1561 End;
1562
1563Procedure TFTPNotifyControl.WMFTPUpdate(Var Msg:TMessage);
1564Begin
1565 If FFTP.OnTransferProgress<>Nil Then
1566 FFTP.OnTransferProgress(FFTP,Msg.Param1,Msg.Param2);
1567End;
1568
1569Procedure TFTPNotifyControl.SetupComponent;
1570Begin
1571 Inherited SetupComponent;
1572 Include (ComponentState, csDetail);
1573End;
1574
1575Procedure TFTPNotifyControl.CreateWnd; //dummy
1576Begin
1577 Inherited CreateWnd;
1578End;
1579
1580Const
1581 FTPSERVICE =1; /* ftp: ftp/tcp: unknown service */
1582 FTPHOST =2; /* unknown host */
1583 FTPSOCKET =3; /* unable to obtain socket */
1584 FTPCONNECT =4; /* unable to connect to server */
1585 FTPLOGIN =5; /* login failed */
1586 FTPABORT =6; /* transfer aborted */
1587 FTPLOCALFILE =7; /* problem openning local file */
1588 FTPDATACONN =8; /* problem initializing data connection */
1589 FTPCOMMAND =9; /* command failed */
1590 FTPPROXYTHIRD =10; /* proxy server does not support third party transfers */
1591 FTPNOPRIMARY =11; /* No primary connection for proxy transfer */
1592 FTPNOXLATETBL =12; /* No code page translation table was loded */
1593
1594 T_ASCII =1;
1595 T_EBCDIC =2;
1596 T_BINARY =3;
1597
1598 /* ping error codes */
1599 PINGREPLY =-1; /* host does not reply */
1600 PINGSOCKET =-3; /* unable to obtain socket */
1601 PINGPROTO =-4; /* unknown protcol ICMP */
1602 PINGSEND =-5; /* send failed */
1603 PINGRECV =-6; /* recv failed */
1604 PINGHOST =-7; /* can't resolve the host name */
1605
1606Procedure TFTP.FTPError(Err:TFTPError);
1607Var Desc:String;
1608Begin
1609 Case Err Of
1610 ftpUnknownService:Desc:='Unknown service';
1611 ftpUnkownHost:Desc:='Unknown host';
1612 ftpSocketError:Desc:='Unable to obtain socket';
1613 ftpCannotConnect:Desc:='Unable to connect to server';
1614 ftpLoginFailed:Desc:='Login failed';
1615 ftpTransferAborted:Desc:='Transfer aborted';
1616 ftpCannotOpenFile:Desc:='Problem openning local file';
1617 ftpConnectionError:Desc:='Problem initializing data connection';
1618 fptCommandFailed:Desc:='Command failed';
1619 ftpProxyError:Desc:='Proxy server does not support third party transfers';
1620 ftpNoPrimaryProxy:Desc:='No primary connection for proxy transfer';
1621 ftpNoTranslateTable:Desc:='No code page translation table was loded';
1622 Else Desc:='Unkown FTP error';
1623 End; //case
1624 If FOnError<>Nil Then FOnError(Self,Err,Desc);
1625End;
1626
1627Function TFTP.GetFTPError:TFTPError;
1628Var Value:LongInt;
1629Begin
1630 Value:=Fftp_errno;
1631 Case Value Of
1632 FTPSERVICE:Result:=ftpUnknownService;
1633 FTPHOST:Result:=ftpUnkownHost;
1634 FTPSOCKET:Result:=ftpSocketError;
1635 FTPCONNECT:Result:=ftpCannotConnect;
1636 FTPLOGIN:Result:=ftpLoginFailed;
1637 FTPABORT:Result:=ftpTransferAborted;
1638 FTPLOCALFILE:Result:=ftpCannotOpenFile;
1639 FTPDATACONN:Result:=ftpConnectionError;
1640 FTPCOMMAND:Result:=fptCommandFailed;
1641 FTPPROXYTHIRD:Result:=ftpProxyError;
1642 FTPNOPRIMARY:Result:=ftpNoPrimaryProxy;
1643 FTPNOXLATETBL:Result:=ftpNoTranslateTable;
1644 Else Result:=ftpOther;
1645 End;
1646End;
1647
1648Function TFTP.GetPassWord:String;
1649Begin
1650 If FPassWord<>Nil Then Result:=FPassWord^
1651 Else Result:='';
1652End;
1653
1654Procedure TFTP.SetPassWord(NewValue:String);
1655Begin
1656 If FPassWord<>Nil Then FreeMem(FPassWord,length(FPassWord^)+1);
1657 GetMem(FPassWord,length(NewValue)+1);
1658 FPassWord^:=NewValue;
1659End;
1660
1661Function TFTP.GetRemoteHost:String;
1662Begin
1663 If FRemoteHost<>Nil Then Result:=FRemoteHost^
1664 Else Result:='';
1665End;
1666
1667Procedure TFTP.SetRemoteHost(NewValue:String);
1668Begin
1669 If FRemoteHost<>Nil Then FreeMem(FRemoteHost,length(FRemoteHost^)+1);
1670 GetMem(FRemoteHost,length(NewValue)+1);
1671 FRemoteHost^:=NewValue;
1672End;
1673
1674Function TFTP.GetRemoteAccount:String;
1675Begin
1676 If FRemoteAccount<>Nil Then Result:=FRemoteAccount^
1677 Else Result:='';
1678End;
1679
1680Procedure TFTP.SetRemoteAccount(NewValue:String);
1681Begin
1682 If FRemoteAccount<>Nil Then FreeMem(FRemoteAccount,length(FRemoteAccount^)+1);
1683 GetMem(FRemoteAccount,length(NewValue)+1);
1684 FRemoteAccount^:=NewValue;
1685End;
1686
1687Function TFTP.GetUserID:String;
1688Begin
1689 If FUserId<>Nil Then Result:=FUserId^
1690 Else Result:='';
1691End;
1692
1693Procedure TFTP.SetUserID(NewValue:String);
1694Begin
1695 If FUserId<>Nil Then FreeMem(FUserId,length(FUserId^)+1);
1696 GetMem(FUserId,length(NewValue)+1);
1697 FUserId^:=NewValue;
1698End;
1699
1700Procedure TFTP.SetupComponent;
1701Var C,DLLName:CString;
1702Begin
1703 Inherited SetupComponent;
1704 Name:='FTP';
1705 RemoteHost:='127.0.0.1';
1706 TransferMode:=ftpBinary;
1707
1708 DllName:='FTPAPI';
1709 {$IFDEF OS2}
1710 If DosLoadModule(C,255,DllName,FDllHandle)<>0 Then
1711 Begin
1712 FDLLHandle:=0;
1713 If ComponentState * [csWriting,csDesigning] = [] Then
1714 Begin
1715 If ApplicationType=1 Then ErrorBox('DLL not found: FTPAPI.DLL !')
1716 Else Writeln('DLL not found: FTPAPI.DLL !');
1717 End;
1718 Exit;
1719 End;
1720 {$ENDIF}
1721 {$IFDEF WIN32}
1722 If ComponentState * [csWriting,csDesigning] = []
1723 Then ErrorBox('TFTP currently not supported for Win32 !');
1724 Exit;
1725 {$ENDIF}
1726 Try
1727 Fftplogoff:=Pointer(GetProcAddr(FDllHandle,'FTPLOGOFF'));
1728 Fftpget:=Pointer(GetProcAddr(FDllHandle,'FTPGET'));
1729 Fftpput:=Pointer(GetProcAddr(FDllHandle,'FTPPUT'));
1730 Fftpappend:=Pointer(GetProcAddr(FDllHandle,'FTPAPPEND'));
1731 Fftpputunique:=(GetProcAddr(FDllHandle,'FTPPUTUNIQUE'));
1732 Fftpcd:=(GetProcAddr(FDllHandle,'FTPCD'));
1733 Fftpmkd:=(GetProcAddr(FDllHandle,'FTPMKD'));
1734 Fftprmd:=(GetProcAddr(FDllHandle,'FTPRMD'));
1735 Fftpdelete:=(GetProcAddr(FDllHandle,'FTPDELETE'));
1736 Fftprename:=(GetProcAddr(FDllHandle,'FTPRENAME'));
1737 Fftpls:=(GetProcAddr(FDllHandle,'FTPLS'));
1738 Fftpdir:=(GetProcAddr(FDllHandle,'FTPDIR'));
1739 Fftpquote:=(GetProcAddr(FDllHandle,'FTPQUOTE'));
1740 Fftpping:=(GetProcAddr(FDllHandle,'FTPPING'));
1741 Fftppwd:=(GetProcAddr(FDllHandle,'FTPPWD'));
1742 Fftpsys:=(GetProcAddr(FDllHandle,'FTPSYS'));
1743 Fftpver:=(GetProcAddr(FDllHandle,'FTPVER'));
1744 FftpWindow:=(GetProcAddr(FDllHandle,'FTPWINDOW'));
1745 Fftp_errno:=(GetProcAddr(FDllHandle,'FTP_ERRNO'));
1746
1747 If ApplicationType=1 Then
1748 Begin
1749 FNotifyControl:=TFTPNotifyControl.Create(Self);
1750 TFTPNotifyControl(FNotifyControl).FFTP:=Self;
1751 TFTPNotifyControl(FNotifyControl).CreateWnd;
1752 End;
1753
1754 If FNotifyControl<>Nil Then FftpWindow(FNotifyControl.Handle); //start FTP services
1755 Except
1756 {$IFDEF OS2}
1757 DosFreeModule(FDLLHandle);
1758 {$ENDIF}
1759 FDLLHandle:=0;
1760 ON E:EProcAddrError Do
1761 Begin
1762 If ComponentState * [csWriting,csDesigning] = [] Then
1763 Begin
1764 If ApplicationType=1 Then ErrorBox('Cannot retrieve procedure from FTPAPI:'+E.Message+' !')
1765 Else Writeln('Cannot retrieve procedure from FTPAPI:'+E.Message+' !');
1766 End;
1767 End;
1768 Else Raise;
1769 End;
1770End;
1771
1772Function TFTP.GetRemoteDirName:String;
1773Var C:CString;
1774Begin
1775 Result:='';
1776 If FDLLHandle=0 Then exit
1777 Else If not FConnected Then exit
1778 Else
1779 Begin
1780 If Fftppwd(RemoteHost,UserId,Password,RemoteAccount,C,250)=0 Then Result:=C
1781 Else
1782 Begin
1783 Result:='';
1784 FTPError(GetFTPError);
1785 End;
1786 End;
1787End;
1788
1789Procedure TFTP.SetRemoteDirName(NewValue:String);
1790Begin
1791 If FDLLHandle=0 Then exit
1792 Else If not Connected Then
1793 Begin
1794 FTPError(ftpNotConnected);
1795 exit;
1796 End
1797 Else
1798 Begin
1799 If Fftpcd(RemoteHost,UserId,Password,RemoteAccount,NewValue)<>0 Then
1800 FTPError(GetFTPError);
1801 End;
1802End;
1803
1804Procedure SystemAssign(Var f:File;Const Name:String);
1805Begin
1806 System.Assign(f,Name);
1807End;
1808
1809Function TFTP.GetRemoteDir(Const Pattern:String;Dir:TStrings;Options:TFTPDirOptions):TFTPError;
1810Var Res:LongInt;
1811 TempFile,s:String;
1812 f:TEXT;
1813Begin
1814 If FDLLHandle=0 Then Result:=ftpOther
1815 Else If not Connected Then Result:=ftpNotConnected
1816 Else
1817 Begin
1818 TempFile:=GetTempFileName;
1819 Dir.Clear;
1820 If Options=ftpDirShort Then
1821 Res:=Fftpls(RemoteHost,UserId,Password,RemoteAccount,TempFile,Pattern)
1822 Else
1823 Res:=Fftpdir(RemoteHost,UserId,Password,RemoteAccount,TempFile,Pattern);
1824 If Res<>0 Then Result:=GetFTPError
1825 Else
1826 Begin
1827 Result:=ftpOk;
1828 SystemAssign(f,TempFile);
1829 {$I-}
1830 Reset(f);
1831 {$I+}
1832 If IoResult<>0 Then Result:=ftpOther
1833 Else While not Eof(f) Do
1834 Begin
1835 {$I-}
1836 Readln(f,s);
1837 {$I+}
1838 If IoResult<>0 Then Break;
1839 Dir.Add(s);
1840 End;
1841 {$I-}
1842 Close(f);
1843 {$I+}
1844 End;
1845 {$I-}
1846 SystemAssign(f,TempFile);
1847 Erase(f);
1848 {$I+}
1849 End;
1850 If Result<>ftpOk Then FTPError(Result);
1851End;
1852
1853Function TFTP.Connect:TFTPError;
1854Begin
1855 If FDLLHandle=0 Then Result:=ftpOther
1856 Else If Connected Then Result:=ftpOk
1857 Else
1858 Begin
1859 If Fftpcd(RemoteHost,UserId,Password,RemoteAccount,'.')<>0 Then Result:=GetFTPError
1860 Else Result:=ftpOk;
1861 FConnected:=Result=ftpOk;
1862 End;
1863 If Result<>ftpOk Then FTPError(Result);
1864End;
1865
1866Procedure TFTP.Disconnect;
1867Begin
1868 If not FConnected Then exit;
1869 If FDLLHandle=0 Then exit;
1870 FConnected:=False;
1871End;
1872
1873Procedure TFTP.SetConnected(NewValue:Boolean);
1874Begin
1875 If NewValue Then Connect
1876 Else Disconnect;
1877End;
1878
1879Destructor TFTP.Destroy;
1880Begin
1881 Disconnect;
1882 If FPassWord<>Nil Then FreeMem(FPassWord,length(FPassWord^)+1);
1883 If FRemoteHost<>Nil Then FreeMem(FRemoteHost,length(FRemoteHost^)+1);
1884 If FRemoteAccount<>Nil Then FreeMem(FRemoteAccount,length(FRemoteAccount^)+1);
1885 If FUserId<>Nil Then FreeMem(FUserId,length(FUserId^)+1);
1886 If FNotifyControl<>Nil Then FNotifyControl.Destroy;
1887 FNotifyControl:=Nil;
1888 If FDllHandle<>0 Then
1889 Begin
1890 {$IFDEF OS2}
1891 DosFreeModule(FDLLHandle);
1892 {$ENDIF}
1893 FDLLHandle:=0;
1894 End;
1895 Inherited Destroy;
1896End;
1897
1898Function TFTP.GetVersion:String;
1899Var C:CString;
1900Begin
1901 If FDLLHandle=0 Then exit;
1902 Fftpver(C,250);
1903 Result:=C;
1904End;
1905
1906Function TFTP.DeleteRemoteFile(Const FileName:String):TFTPError;
1907Begin
1908 If FDLLHandle=0 Then Result:=ftpOther
1909 Else If not Connected Then Result:=ftpNotConnected
1910 Else
1911 Begin
1912 If FftpDelete(RemoteHost,UserId,Password,RemoteAccount,FileName)=0 Then Result:=ftpOk
1913 Else Result:=GetFTPError;
1914 End;
1915 If Result<>ftpOk Then FTPError(Result);
1916End;
1917
1918Function TFTP.RenameRemoteFile(Const OldName,NewName:String):TFTPError;
1919Begin
1920 If FDLLHandle=0 Then Result:=ftpOther
1921 Else If not Connected Then Result:=ftpNotConnected
1922 Else
1923 Begin
1924 If FftpRename(RemoteHost,UserId,Password,RemoteAccount,OldName,NewName)=0 Then Result:=ftpOk
1925 Else Result:=GetFTPError;
1926 End;
1927 If Result<>ftpOk Then FTPError(Result);
1928End;
1929
1930Function TFTP.MakeRemoteDir(Const DirName:String):TFTPError;
1931Begin
1932 If FDLLHandle=0 Then Result:=ftpOther
1933 Else If not Connected Then Result:=ftpNotConnected
1934 Else
1935 Begin
1936 If Fftpmkd(RemoteHost,UserId,Password,RemoteAccount,DirName)=0 Then Result:=ftpOk
1937 Else Result:=GetFTPError;
1938 End;
1939 If Result<>ftpOk Then FTPError(Result);
1940End;
1941
1942Function TFTP.RemoveRemoteDir(Const DirName:String):TFTPError;
1943Begin
1944 If FDLLHandle=0 Then Result:=ftpOther
1945 Else If not Connected Then Result:=ftpNotConnected
1946 Else
1947 Begin
1948 If Fftprmd(RemoteHost,UserId,Password,RemoteAccount,DirName)=0 Then Result:=ftpOk
1949 Else Result:=GetFTPError;
1950 End;
1951 If Result<>ftpOk Then FTPError(Result);
1952End;
1953
1954Function TFTP.AppendToRemoteFile(Const RemoteFileName,LocalFileName:String):TFTPError;
1955Var tt:LongInt;
1956Begin
1957 If FDLLHandle=0 Then Result:=ftpOther
1958 Else If not Connected Then Result:=ftpNotConnected
1959 Else
1960 Begin
1961 If TransferMode=ftpAscii Then tt:=T_ASCII
1962 Else tt:=T_BINARY;
1963 If Fftpappend(RemoteHost,UserId,Password,RemoteAccount,
1964 LocalFileName,RemoteFileName,tt)=0 Then Result:=ftpOk
1965 Else Result:=GetFTPError;
1966 End;
1967 If Result<>ftpOk Then FTPError(Result);
1968End;
1969
1970Function TFTP.GetRemoteFile(Const RemoteFileName,LocalFileName:String):TFTPError;
1971Var tt:LongInt;
1972Begin
1973 If FDLLHandle=0 Then Result:=ftpOther
1974 Else If not Connected Then Result:=ftpNotConnected
1975 Else
1976 Begin
1977 If TransferMode=ftpAscii Then tt:=T_ASCII
1978 Else tt:=T_BINARY;
1979 If Fftpget(RemoteHost,UserId,Password,RemoteAccount,
1980 LocalFileName,RemoteFileName,'w',tt)=0 Then Result:=ftpOk
1981 Else Result:=GetFTPError;
1982 End;
1983 If Result<>ftpOk Then FTPError(Result);
1984End;
1985
1986Function TFTP.PutLocalFile(Const LocalFileName,RemoteFileName:String):TFTPError;
1987Var tt:LongInt;
1988Begin
1989 If FDLLHandle=0 Then Result:=ftpOther
1990 Else If not Connected Then Result:=ftpNotConnected
1991 Else
1992 Begin
1993 If TransferMode=ftpAscii Then tt:=T_ASCII
1994 Else tt:=T_BINARY;
1995 If Fftpput(RemoteHost,UserId,Password,RemoteAccount,
1996 LocalFileName,RemoteFileName,tt)=0 Then Result:=ftpOk
1997 Else Result:=GetFTPError;
1998 End;
1999 If Result<>ftpOk Then FTPError(Result);
2000End;
2001
2002Function TFTP.PutUniqueLocalFile(Const LocalFileName,RemoteFileName:String):TFTPError;
2003Var tt:LongInt;
2004Begin
2005 If FDLLHandle=0 Then Result:=ftpOther
2006 Else If not Connected Then Result:=ftpNotConnected
2007 Else
2008 Begin
2009 If TransferMode=ftpAscii Then tt:=T_ASCII
2010 Else tt:=T_BINARY;
2011 If Fftpputunique(RemoteHost,UserId,Password,RemoteAccount,
2012 LocalFileName,RemoteFileName,tt)=0 Then Result:=ftpOk
2013 Else Result:=GetFTPError;
2014 End;
2015 If Result<>ftpOk Then FTPError(Result);
2016End;
2017
2018Function TFTP.Quote(Const ftpstring:String):TFTPError;
2019Begin
2020 If FDLLHandle=0 Then Result:=ftpOther
2021 Else If not Connected Then Result:=ftpNotConnected
2022 Else
2023 Begin
2024 If Fftpquote(RemoteHost,UserId,Password,RemoteAccount,ftpString)=0 Then Result:=ftpOk
2025 Else Result:=GetFTPError;
2026 End;
2027 If Result<>ftpOk Then FTPError(Result);
2028End;
2029
2030Function TFTP.GetSystem:String;
2031Var C:CString;
2032Begin
2033 If FDLLHandle=0 Then Result:=''
2034 Else If not Connected Then
2035 Begin
2036 Result:='';
2037 FTPError(ftpNotConnected);
2038 End
2039 Else
2040 Begin
2041 If Fftpsys(RemoteHost,UserId,Password,RemoteAccount,C,250)=0 Then Result:=C
2042 Else
2043 Begin
2044 Result:='';
2045 FTPError(GetFTPError);
2046 End;
2047 End;
2048End;
2049
2050Function TFTP.Ping(Const HostName:String;PacketLen:LongInt;
2051 Var Address:LongWord;Var Milliseconds:LongInt):TFTPPingResult;
2052Begin
2053 If FDLLHandle=0 Then Result:=ftpPingOther
2054 Else
2055 Begin
2056 Milliseconds:=FftpPing(HostName,PacketLen,Address);
2057 If Milliseconds<0 Then
2058 Begin
2059 Case Milliseconds Of
2060 PINGREPLY:Result:=ftpPingHostDoesNotReply;
2061 PINGSOCKET:Result:=ftpPingSocketError;
2062 PINGPROTO:Result:=ftpPingUnkownProtocol;
2063 PINGSEND:Result:=ftpPingSendFailed;
2064 PINGRECV:Result:=ftpPingReceiveFailed;
2065 PINGHOST:Result:=ftpPingUnkownHost;
2066 Else Result:=ftpPingOther;
2067 End; //case
2068 End
2069 Else Result:=ftpPingOk;
2070 End;
2071End;
2072
2073{
2074ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2075º º
2076º Speed-Pascal/2 Version 2.0 º
2077º º
2078º Speed-Pascal Component Classes (SPCC) º
2079º º
2080º This section: TTCP Class Implementation º
2081º º
2082º Last Modified: September 1995 º
2083º º
2084º (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited ! º
2085º º
2086ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2087}
2088
2089Const
2090 INADDR_ANY =$00000000;
2091
2092 /* Address families. */
2093Const
2094 AF_UNSPEC =0; /* unspecified */
2095 AF_UNIX =1; /* local to host (pipes, portals) */
2096 AF_INET =2; /* internetwork: UDP, TCP, etc. */
2097 AF_IMPLINK =3; /* arpanet imp addresses */
2098 AF_PUP =4; /* pup protocols: e.g. BSP */
2099 AF_CHAOS =5; /* mit CHAOS protocols */
2100 AF_NS =6; /* XEROX NS protocols */
2101 AF_NBS =7; /* nbs protocols */
2102 AF_ECMA =8; /* european computer manufacturers */
2103 AF_DATAKIT =9; /* datakit protocols */
2104 AF_CCITT =10; /* CCITT protocols, X.25 etc */
2105 AF_SNA =11; /* IBM SNA */
2106 AF_DECnet =12; /* DECnet */
2107 AF_DLI =13; /* Direct data link interface */
2108 AF_LAT =14; /* LAT */
2109 AF_HYLINK =15; /* NSC Hyperchannel */
2110 AF_APPLETALK =16; /* Apple Talk */
2111
2112 AF_MAX =17;
2113
2114 /* Protocol families, same as address families for now. */
2115Const
2116 PF_UNSPEC =AF_UNSPEC;
2117 PF_UNIX =AF_UNIX;
2118 PF_INET =AF_INET;
2119 PF_IMPLINK =AF_IMPLINK;
2120 PF_PUP =AF_PUP;
2121 PF_CHAOS =AF_CHAOS;
2122 PF_NS =AF_NS;
2123 PF_NBS =AF_NBS;
2124 PF_ECMA =AF_ECMA;
2125 PF_DATAKIT =AF_DATAKIT;
2126 PF_CCITT =AF_CCITT;
2127 PF_SNA =AF_SNA;
2128 PF_DECnet =AF_DECnet;
2129 PF_DLI =AF_DLI;
2130 PF_LAT =AF_LAT;
2131 PF_HYLINK =AF_HYLINK;
2132 PF_APPLETALK =AF_APPLETALK;
2133
2134 PF_MAX =AF_MAX;
2135
2136Const
2137 SOCK_STREAM =1; /* stream socket */
2138 SOCK_DGRAM =2; /* datagram socket */
2139 SOCK_RAW =3; /* raw-protocol interface */
2140 SOCK_RDM =4; /* reliably-delivered message */
2141 SOCK_SEQPACKET =5; /* sequenced packet stream */
2142
2143 MSG_PEEK =2;
2144
2145Type
2146 sockaddr=Record
2147 sa_family:WORD; /* address family */
2148 sa_data:CSTRING[13]; /* up to 14 bytes of direct address */
2149 End;
2150
2151 PCharArray=^TCharArray;
2152 TCharArray=Array[0..0] Of PChar;
2153
2154 hostent=Record
2155 h_name:PChar; /* official name of host */
2156 h_aliases:PCharArray; /* alias list */
2157 h_addrtype:LongInt; /* host address type */
2158 h_length:LongInt; /* length of address */
2159 h_addr_list:PCharArray; /* list of addresses from name server */
2160 //h_addr h_addr_list[0] /* address, for backward compatiblity */
2161 End;
2162 phostent=^hostent;
2163
2164 in_addr=Record
2165 s_addr:LongWord;
2166 End;
2167
2168 sockaddr_in=Record
2169 sin_family:SmallInt;
2170 sin_port:Word;
2171 sin_addr:in_addr;
2172 sin_zero:Array[0..7] Of Char;
2173 End;
2174
2175
2176Procedure TTCP.SetupComponent;
2177Var C,DLLName:CString;
2178Begin
2179 Inherited SetupComponent;
2180 Name:='TCP';
2181 LocalPort:=1024;
2182 LocalAddress:=INADDR_ANY;
2183 QueueLength:=1;
2184 FSockMode:=SOCK_STREAM;
2185 FState:=sckClosed;
2186
2187 DllName:='SO32DLL';
2188 {$IFDEF OS2}
2189 If DosLoadModule(C,255,DllName,FDllHandle)<>0 Then
2190 Begin
2191 FDLLHandle:=0;
2192 If ComponentState * [csWriting,csDesigning] = [] Then
2193 Begin
2194 If ApplicationType=1 Then ErrorBox('DLL not found: SO32DLL.DLL !')
2195 Else Writeln('DLL not found: SO32DLL.DLL !');
2196 End;
2197 Exit;
2198 End;
2199 DllName:='TCP32DLL';
2200 If DosLoadModule(C,255,DllName,FTCPDllHandle)<>0 Then
2201 Begin
2202 {$IFDEF OS2}
2203 DosFreeModule(FDLLHandle);
2204 {$ENDIF}
2205 FDLLHandle:=0;
2206 FTCPDLLHandle:=0;
2207 If ComponentState * [csWriting,csDesigning] = [] Then
2208 Begin
2209 If ApplicationType=1 Then ErrorBox('DLL not found: TCP32DLL.DLL !')
2210 Else Writeln('DLL not found: TCP32DLL.DLL !');
2211 End;
2212 Exit;
2213 End;
2214 {$ENDIF}
2215 {$IFDEF WIN32}
2216 If ComponentState * [csWriting,csDesigning] = []
2217 Then ErrorBox('TTCP currently not supported for Win32 !');
2218 Exit;
2219 {$ENDIF}
2220 Try
2221 FAccept:=Pointer(GetProcAddr(FDllHandle,'ACCEPT'));
2222 FSock_Init:=Pointer(GetProcAddr(FDllHandle,'SOCK_INIT'));
2223 FSoClose:=Pointer(GetProcAddr(FDllHandle,'SOCLOSE'));
2224 FBind:=Pointer(GetProcAddr(FDllHandle,'BIND'));
2225 FConnect:=Pointer(GetProcAddr(FDllHandle,'CONNECT'));
2226 FGethostid:=Pointer(GetProcAddr(FDllHandle,'GETHOSTID'));
2227 FGetpeername:=Pointer(GetProcAddr(FDllHandle,'GETPEERNAME'));
2228 FGetsockname:=Pointer(GetProcAddr(FDllHandle,'GETSOCKNAME'));
2229 FGetsockopt:=Pointer(GetProcAddr(FDllHandle,'GETSOCKOPT'));
2230 Fioctl:=Pointer(GetProcAddr(FDllHandle,'IOCTL'));
2231 FListen:=Pointer(GetProcAddr(FDllHandle,'LISTEN'));
2232 Frecvmsg:=Pointer(GetProcAddr(FDllHandle,'RECVMSG'));
2233 Frecv:=Pointer(GetProcAddr(FDllHandle,'RECV'));
2234 Frecvfrom:=Pointer(GetProcAddr(FDllHandle,'RECVFROM'));
2235 Fselect:=Pointer(GetProcAddr(FDllHandle,'SELECT'));
2236 Fsend:=Pointer(GetProcAddr(FDllHandle,'SEND'));
2237 Fsendmsg:=Pointer(GetProcAddr(FDllHandle,'SENDMSG'));
2238 Fsendto:=Pointer(GetProcAddr(FDllHandle,'SENDTO'));
2239 Fsetsockopt:=Pointer(GetProcAddr(FDllHandle,'SETSOCKOPT'));
2240 Fsock_errno:=Pointer(GetProcAddr(FDllHandle,'SOCK_ERRNO'));
2241 Fpsock_errno:=Pointer(GetProcAddr(FDllHandle,'PSOCK_ERRNO'));
2242 FSocket:=Pointer(GetProcAddr(FDllHandle,'SOCKET'));
2243 Fsoabort:=Pointer(GetProcAddr(FDllHandle,'SOABORT'));
2244 Fso_cancel:=Pointer(GetProcAddr(FDllHandle,'SO_CANCEL'));
2245 Freadv:=Pointer(GetProcAddr(FDllHandle,'READV'));
2246 Fwritev:=Pointer(GetProcAddr(FDllHandle,'WRITEV'));
2247 Fshutdown:=Pointer(GetProcAddr(FDllHandle,'SHUTDOWN'));
2248 Fgetinetversion:=Pointer(GetProcAddr(FDllHandle,'GETINETVERSION'));
2249
2250 FINet_Addr:=Pointer(GetProcAddr(FTCPDllHandle,'INET_ADDR'));
2251 Fgethostbyname:=Pointer(GetProcAddr(FTCPDllHandle,'GETHOSTBYNAME'));
2252 FBswap:=Pointer(GetProcAddr(FTCPDllHandle,'BSWAP'));
2253 Fgethostname:=Pointer(GetProcAddr(FTCPDllHandle,'GETHOSTNAME'));
2254
2255 FSock_Init;
2256 Except
2257 {$IFDEF OS2}
2258 DosFreeModule(FDLLHandle);
2259 {$ENDIF}
2260 FDLLHandle:=0;
2261 {$IFDEF OS2}
2262 DosFreeModule(FTCPDLLHandle);
2263 {$ENDIF}
2264 FTCPDLLHandle:=0;
2265 ON E:EProcAddrError Do
2266 Begin
2267 If ComponentState * [csWriting,csDesigning] = [] Then
2268 Begin
2269 If ApplicationType=1 Then ErrorBox('Cannot retrieve procedure from SO32DLL or TCP32DLL:'+E.Message+' !')
2270 Else Writeln('Cannot retrieve procedure from SO32DLL or TCP32DLL:'+E.Message+' !');
2271 End;
2272 End;
2273 Else Raise;
2274 End;
2275End;
2276
2277Procedure TTCP.Close;
2278Begin
2279 If FDLLHandle<>0 Then
2280 Begin
2281 If FInSocket<>0 Then FSoClose(FInSocket);
2282 FInSocket:=0;
2283 If FOutSocket<>0 Then FSoClose(FOutSocket);
2284 FOutSocket:=0;
2285 If FAcceptSocket<>0 Then FSoClose(FAcceptSocket);
2286 FAcceptSocket:=0;
2287 End;
2288 FConnected:=False;
2289 FState:=sckClosed;
2290End;
2291
2292Destructor TTCP.Destroy;
2293Begin
2294 Close;
2295
2296 If FDllHandle<>0 Then
2297 Begin
2298 {$IFDEF OS2}
2299 DosFreeModule(FDLLHandle);
2300 {$ENDIF}
2301 FDLLHandle:=0;
2302 End;
2303 If FTCPDllHandle<>0 Then
2304 Begin
2305 {$IFDEF OS2}
2306 DosFreeModule(FTCPDLLHandle);
2307 {$ENDIF}
2308 FTCPDLLHandle:=0;
2309 End;
2310 Inherited Destroy;
2311End;
2312
2313Procedure TTCP.Listen; //Server starts this to listen for connection requests
2314Var Server,Server1:sockaddr_in;
2315 nameLen:LongInt;
2316Begin
2317 If FDllHandle=0 Then exit;
2318
2319 If FInSocket=0 Then
2320 Begin
2321 /* Request a socket */
2322 FInSocket:=Fsocket(PF_INET, FSockMode, 0);
2323 If FInSocket<0 Then //Error
2324 Begin
2325 FErrorCode:=Fsock_errno;
2326 TCPError(FErrorCode);
2327 exit;
2328 End
2329 Else FErrorCode:=0;
2330
2331 /* Bind the socket to the server address.*/
2332 FillChar(Server,sizeof(Server),0);
2333 Server.sin_family := AF_INET;
2334 Server.sin_port := FBswap(LocalPort);
2335 Server.sin_addr.s_addr := LocalAddress;
2336
2337 If Fbind(FInSocket,Server,sizeof(Server)) < 0 Then
2338 Begin //Error
2339 FErrorCode:=Fsock_errno;
2340 TCPError(FErrorCode);
2341 exit;
2342 End
2343 Else
2344 Begin
2345 FErrorCode:=0;
2346 //Find out what port is really assigned
2347 FillChar(Server1,sizeof(Server1),0);
2348 NameLen:=sizeof(Server1);
2349 If FGetSockName(FOutSocket,Server1,NameLen)=0 Then
2350 FLocalPort:=Fbswap(server1.sin_port);
2351 End;
2352 End;
2353
2354 /* Listen for connections */
2355 FState:=sckListening;
2356 If Flisten(FInSocket,QueueLength)<>0 Then //Error
2357 Begin
2358 FErrorCode:=Fsock_errno;
2359 TCPError(FErrorCode);
2360 exit;
2361 End
2362 Else FErrorCode:=0;
2363
2364 //Listen returns if connection attempt is made by client
2365End;
2366
2367Function TTCP.INetAddressFromName(Const Name:String):LongWord;
2368Begin
2369 If FDLLHandle=0 Then exit;
2370 Result:=FINet_Addr(Name);
2371End;
2372
2373Procedure TTCP.Connect(Const RemoteHost:String;RemotePort:LongInt);
2374Var hostnm:phostent;
2375 Server:sockaddr_in;
2376 IP:LongWord;
2377Type PLong=^LongWord;
2378Begin //Client starts this to connect to a server
2379 hostnm := Fgethostbyname(RemoteHost);
2380 If hostnm=Nil Then IP:=Finet_addr(RemoteHost)
2381 Else IP:=PLong(hostnm^.h_addr_list^[0])^;
2382
2383 FillChar(Server,sizeof(Server),0);
2384 server.sin_family := AF_INET;
2385 server.sin_port := FBswap(RemotePort);
2386 server.sin_addr.s_addr := IP;
2387
2388 If FOutSocket=0 Then
2389 Begin
2390 /* Get a stream socket. */
2391 FOutSocket := Fsocket(PF_INET, FSockMode, 0);
2392 If FOutSocket<0 Then //Error
2393 Begin
2394 FErrorCode:=Fsock_errno;
2395 TCPError(FErrorCode);
2396 FState:=sckError;
2397 exit;
2398 End
2399 Else FErrorCode:=0;
2400 End;
2401
2402 /* Connect to the server. */
2403 If FConnect(FOutSocket,server,sizeof(server)) < 0 Then
2404 Begin //Error
2405 FErrorCode:=Fsock_errno;
2406 FState:=sckError;
2407 TCPError(FErrorCode);
2408 exit;
2409 End
2410 Else
2411 Begin
2412 FErrorCode:=0;
2413 If FOnConnect<>Nil Then FOnConnect(Self);
2414 FConnected:=True;
2415 FState:=sckConnected;
2416 End;
2417End;
2418
2419Function TTCP.GetLocalHostName:String;
2420Var C:CString;
2421Begin
2422 If FDllHandle=0 Then exit;
2423 If Fgethostname(C,255)=0 Then Result:=C
2424 Else Result:='';
2425End;
2426
2427Function TTCP.GetLocalIP:String;
2428Var l:LongWord;
2429Begin
2430 If FDllHandle=0 Then exit;
2431 l:=Fgethostid;
2432 Result:=tostr(l And 255);
2433 l:=l SHR 8;
2434 Result:=tostr(l And 255)+'.'+Result;
2435 l:=l SHR 8;
2436 Result:=tostr(l And 255)+'.'+Result;
2437 l:=l SHR 8;
2438 Result:=tostr(l And 255)+'.'+Result;
2439End;
2440
2441Function TTCP.GetLocalPort:LongInt;
2442Begin
2443 Result:=FLocalPort;
2444End;
2445
2446Procedure TTCP.SetLocalPort(NewValue:LongInt);
2447Begin
2448 FLocalPort:=NewValue;
2449End;
2450
2451Procedure TTCP.Accept(Var PortID:LongInt;Var IP:String);
2452Var Client:sockaddr_in;
2453 NameLen:LongInt;
2454 l:LongWord;
2455Begin
2456 If FDllHandle=0 Then exit;
2457 If FAcceptSocket<>0 Then FSoClose(FAcceptSocket);
2458 FAcceptSocket:=0;
2459 Namelen:=sizeof(Client);
2460 FillChar(Client,sizeof(Client),0);
2461 FAcceptSocket:=Faccept(FInSocket,client,namelen);
2462 If FAcceptSocket=-1 Then //Error
2463 Begin
2464 FErrorCode:=Fsock_errno;
2465 PortID:=0;
2466 IP:='';
2467 TCPError(FErrorCode);
2468 FState:=sckError;
2469 exit;
2470 End
2471 Else
2472 Begin
2473 FErrorCode:=0;
2474 PortID:=Client.sin_port;
2475 l:=Client.sin_addr.s_addr;
2476 IP:=tostr(l And 255);
2477 l:=l SHR 8;
2478 IP:=IP+'.'+tostr(l And 255);
2479 l:=l SHR 8;
2480 IP:=IP+'.'+tostr(l And 255);
2481 l:=l SHR 8;
2482 IP:=IP+'.'+tostr(l And 255);
2483 If FOnConnectionRequest<>Nil Then FOnConnectionRequest(Self,PortId,IP);
2484 FConnected:=True;
2485 FState:=sckConnected;
2486 End;
2487End;
2488
2489Procedure TTCP.SendData(Var Buf;BufLen:LongInt);
2490Var s:LongWord;
2491Begin
2492 If FDLLHandle=0 Then exit;
2493 If FAcceptSocket<>0 Then s:=FAcceptSocket
2494 Else If FOutSocket<>0 Then s:=FOutSocket
2495 Else s:=FInSocket;
2496
2497 If Fsend(s,Buf,BufLen,0) < 0 Then //Error
2498 Begin
2499 FErrorCode:=Fsock_errno;
2500 TCPError(FErrorCode);
2501 exit;
2502 End
2503 Else
2504 Begin
2505 FErrorCode:=0;
2506 If FOnSendComplete<>Nil Then FOnSendComplete(Self);
2507 End;
2508End;
2509
2510Procedure TTCP.GetData(Var Buf;MaxLen:LongInt;Var Received:LongInt);
2511Var s:LongWord;
2512Begin
2513 If FDLLHandle=0 Then exit;
2514 If FAcceptSocket<>0 Then s:=FAcceptSocket
2515 Else If FOutSocket<>0 Then s:=FOutSocket
2516 Else s:=FInSocket;
2517
2518 Received:=Frecv(s,Buf,MaxLen,0);
2519 If Received = -1 Then
2520 Begin //Error
2521 FErrorCode:=Fsock_errno;
2522 TCPError(FErrorCode);
2523 exit;
2524 End
2525 Else FErrorCode:=0;
2526End;
2527
2528Procedure TTCP.PeekData(Var Buf;MaxLen:LongInt;Var Received:LongInt);
2529Var s:LongWord;
2530Begin
2531 If FDLLHandle=0 Then exit;
2532 If FAcceptSocket<>0 Then s:=FAcceptSocket
2533 Else If FOutSocket<>0 Then s:=FOutSocket
2534 Else s:=FInSocket;
2535
2536 Received:=Frecv(s,Buf,MaxLen,MSG_PEEK);
2537 If Received = -1 Then
2538 Begin //Error
2539 FErrorCode:=Fsock_errno;
2540 TCPError(FErrorCode);
2541 exit;
2542 End
2543 Else FErrorCode:=0;
2544End;
2545
2546Procedure TTCP.TCPError(Code:LongInt);
2547Var s:String;
2548Begin
2549 Case Code Of
2550 SOCEPERM:s:='Not owner';
2551 SOCESRCH:s:='No such process';
2552 SOCEINTR:s:='Interrupted system call';
2553 SOCENXIO:s:='No such device or address';
2554 SOCEBADF:s:='Bad file number';
2555 SOCEACCES:s:='Permission denied';
2556 SOCEFAULT:s:='Bad address';
2557 SOCEINVAL:s:='Invalid argument';
2558 SOCEMFILE:s:='Too many open files';
2559 SOCEPIPE:s:='Broken pipe';
2560 SOCEOS2ERR:s:='OS/2 Error';
2561 SOCEWOULDBLOCK:s:='Operation would block';
2562 SOCEINPROGRESS:s:='Operation now in progress';
2563 SOCEALREADY:s:='Operation already in progress';
2564 SOCENOTSOCK:s:='Socket operation on non-socket';
2565 SOCEDESTADDRREQ:s:='Destination address required';
2566 SOCEMSGSIZE:s:='Message too long';
2567 SOCEPROTOTYPE:s:='Protocol wrong type for socket';
2568 SOCENOPROTOOPT:s:='Protocol not available';
2569 SOCEPROTONOSUPPORT:s:='Protocol not supported';
2570 SOCESOCKTNOSUPPORT:s:='Socket type not supported';
2571 SOCEOPNOTSUPP:s:='Operation not supported on socket';
2572 SOCEPFNOSUPPORT:s:='Protocol family not supported';
2573 SOCEAFNOSUPPORT:s:='Address family not supported by protocol family';
2574 SOCEADDRINUSE:s:='Address already in use';
2575 SOCEADDRNOTAVAIL:s:='Can'#39't assign requested address';
2576 SOCENETDOWN:s:='Network is down';
2577 SOCENETUNREACH:s:='Network is unreachable';
2578 SOCENETRESET:s:='Network dropped connection on reset';
2579 SOCECONNABORTED:s:='Software caused connection abort';
2580 SOCECONNRESET:s:='Connection reset by peer';
2581 SOCENOBUFS:s:='No buffer space available';
2582 SOCEISCONN:s:='Socket is already connected';
2583 SOCENOTCONN:s:='Socket is not connected';
2584 SOCESHUTDOWN:s:='Can'#39't send after socket shutdown';
2585 SOCETOOMANYREFS:s:='Too many references: can'#39't splice';
2586 SOCETIMEDOUT:s:='Connection timed out';
2587 SOCECONNREFUSED:s:='Connection refused';
2588 SOCELOOP:s:='Too many levels of symbolic links';
2589 SOCENAMETOOLONG:s:='File name too long';
2590 SOCEHOSTDOWN:s:='Host is down';
2591 SOCEHOSTUNREACH:s:='No route to host';
2592 SOCENOTEMPTY:s:='Directory not empty';
2593 Else s:='Unkown error';
2594 End; //case
2595 If FOnError<>Nil Then FOnError(Self,Code,s);
2596End;
2597
2598{
2599ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»
2600º º
2601º Speed-Pascal/2 Version 2.0 º
2602º º
2603º Speed-Pascal Component Classes (SPCC) º
2604º º
2605º This section: TUDP Class Implementation º
2606º º
2607º Last Modified: September 1995 º
2608º º
2609º (C) 1995 SpeedSoft. All rights reserved. Disclosure probibited ! º
2610º º
2611ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍŒ
2612}
2613
2614Procedure TUDP.SetupComponent;
2615Begin
2616 Inherited SetupComponent;
2617 FSockMode:=SOCK_DGRAM;
2618End;
2619
2620Procedure TUDP.SendTo(Const RemoteHost:String;RemotePort:LongInt;
2621 Var Buf;BufLen:LongInt);
2622Var server:sockaddr_in;
2623 s:LongWord;
2624Begin
2625 If FDllHandle=0 Then exit;
2626 server.sin_family := AF_INET;
2627 server.sin_port := FBswap(RemotePort);
2628 server.sin_addr.s_addr := Finet_addr(RemoteHost);
2629
2630 If FAcceptSocket<>0 Then s:=FAcceptSocket
2631 Else If FOutSocket<>0 Then s:=FOutSocket
2632 Else If FInSocket<>0 Then s:=FInSocket
2633 Else
2634 Begin
2635 FOutSocket := Fsocket(PF_INET, FSockMode, 0);
2636 If FOutSocket<0 Then //Error
2637 Begin
2638 FErrorCode:=Fsock_errno;
2639 TCPError(FErrorCode);
2640 exit;
2641 End
2642 Else FErrorCode:=0;
2643 s:=FOutSocket;
2644 End;
2645 If FSendTo(s,Buf,BufLen,0,Server,Sizeof(Server))=0 Then FErrorCode:=0
2646 Else
2647 Begin
2648 FErrorCode:=Fsock_errno;
2649 TCPError(FErrorCode);
2650 End;
2651End;
2652
2653Procedure TUDP.ReceiveFrom(Const RemoteHost:String;RemotePort:LongInt;
2654 Var Buf;BufLen:LongWord);
2655Var server:sockaddr_in;
2656 s:LongWord;
2657 NameLen:LongInt;
2658Begin
2659 If FDllHandle=0 Then exit;
2660 server.sin_family := AF_INET;
2661 server.sin_port := FBswap(RemotePort);
2662 server.sin_addr.s_addr := Finet_addr(RemoteHost);
2663
2664 If FAcceptSocket<>0 Then s:=FAcceptSocket
2665 Else If FInSocket<>0 Then s:=FInSocket
2666 Else If FOutSocket<>0 Then s:=FOutSocket
2667 Else
2668 Begin
2669 FInSocket := Fsocket(PF_INET, FSockMode, 0);
2670 If FInSocket<0 Then //Error
2671 Begin
2672 FErrorCode:=Fsock_errno;
2673 TCPError(FErrorCode);
2674 exit;
2675 End
2676 Else FErrorCode:=0;
2677 s:=FInSocket;
2678 End;
2679 NameLen:=sizeof(Server);
2680 If Frecvfrom(s,Buf,BufLen,0,Server,NameLen)=0 Then FErrorCode:=0
2681 Else
2682 Begin
2683 FErrorCode:=Fsock_errno;
2684 TCPError(FErrorCode);
2685 End;
2686
2687End;
2688
2689Initialization
2690 RegisterClasses([THTTPBrowser,TFTP,TUDP,TTCP]);
2691End.
2692
2693(* Changes:
2694
2695 16-Aug-97 J”rg: Fehler in WebExWin-Records gefixt.
2696 Alle Strukturen mit CSTRING[...STRING]
2697 waren falsch bersetzt. Jeweils -1
2698 eingefgt.
2699
2700*)
Note: See TracBrowser for help on using the repository browser.