Develop and Download Open Source Software

Browse CVS Repository

Contents of /gikonavigoeson/gikonavi/ExternalBoardPlugInMain.pas

Parent Directory Parent Directory | Revision Log Revision Log | View Revision Graph Revision Graph


Revision 1.8 - (show annotations) (download) (as text)
Thu Mar 18 03:32:17 2004 UTC (20 years, 1 month ago) by yoffy
Branch: MAIN
Changes since 1.7: +67 -2 lines
File MIME type: text/x-pascal
・プラグインメニューを追加。

1 unit ExternalBoardPlugInMain;
2
3 interface
4
5 uses
6 Windows, Classes, SysUtils, Menus,
7 IdHTTP, IdComponent, IdGlobal, IdException,
8 AbonUnit;
9
10 type
11
12 // ?????潟???若????????????????????
13 TDownloadState = (dsWait, dsWork, dsComplete, dsDiffComplete, dsNotModify, dsAbort, dsError);
14
15 // ??絎????? URL ???????????違?ゃ?潟?у???篁?????????????
16 TAcceptType = (atNoAccept, atBBS, atBoard, atThread);
17
18 // ?<???ャ?若??潟????/span>
19 TMenuHandler = procedure(
20 inHandle : HMENU // ?<???ャ?若??潟????/span>
21 ); stdcall;
22
23 // *************************************************************************
24 // ?????違?ゃ?潟??(罩c???????若????????
25 // *************************************************************************
26 TOnLoad = procedure (
27 inInstance : DWORD // ?????違?ゃ?潟???ゃ?潟?鴻?帥?潟??/span>
28 ); stdcall;
29
30 // *************************************************************************
31 // ?????違?ゃ?潟?????若?吾?с??/span>
32 // *************************************************************************
33 TOnVersionInfo = procedure(
34 var outAgent : PChar; // ???若?吾?с?潟??筝??????障????膣?膕?????腱?/span>
35 var outMajor : DWORD; // ?<?吾?c?若???若?吾?с??/span>
36 var outMinor : DWORD; // ???ゃ???若???若?吾?с??/span>
37 var outRelease : PChar; // ?????若?号?????
38 var outRevision : DWORD // ?????吾?с?潟???潟????/span>
39 ); stdcall;
40
41 // *************************************************************************
42 // ??絎????? URL ???????????違?ゃ?潟?у???篁?????????????
43 // *************************************************************************
44 TOnAcceptURL = function(
45 inURL : PChar // ?ゆ????篁違???с???? URL
46 ): TAcceptType; stdcall; // URL ??┏蕁?
47
48 // *************************************************************************
49 // ?<???ャ?若??潟????/span>
50 // *************************************************************************
51 TOnPlugInMenu = procedure(
52 inInstance : DWORD // ?<???ャ?若??潟????/span>
53 ); stdcall;
54
55 // *************************************************************************
56 // ?鴻???荀с? URL ?????鴻??????? URL ??絨????冴??
57 // *************************************************************************
58 TOnListURL2ThreadURL = function(
59 inListURL : PChar; // ?鴻???荀с??腓冴???? URL
60 inFileName : PChar // ?鴻?????????<?ゃ????
61 ) : PChar; stdcall; // ?鴻??????? URL
62
63 function CreateResultString(
64 resultStr : string
65 ) : PChar; stdcall;
66
67 procedure DisposeResultString(
68 resultStr : PChar
69 ); stdcall;
70
71 implementation
72
73 uses ExternalBoardManager, ExternalThreadItem, GikoSystem, BoardGroup, Giko;
74
75 // *************************************************************************
76 // ?祉???ゃ?? PChar ?с???? API ???<?≪????腆坂?????
77 // *************************************************************************
78 function CreateResultString(
79 resultStr : string
80 ) : PChar; stdcall;
81 var
82 tmp : PChar;
83 begin
84
85 tmp := PChar( resultStr );
86 GetMem( Result, Length( tmp ) + 1 );
87 Move( tmp^, Result^, Length( tmp ) + 1 );
88
89 end;
90
91 // *************************************************************************
92 // ?祉???ゃ?? PChar ?с???? API ???<?≪???????障????
93 // *************************************************************************
94 procedure DisposeResultString(
95 resultStr : PChar
96 ); stdcall;
97 begin
98
99 FreeMem( resultStr );
100
101 end;
102
103 // *************************************************************************
104 // ?????違????????????若?吾?с?潟????緇?????
105 // *************************************************************************
106 procedure VersionInfo(
107 var outAgent : PChar; // ???若?吾?с?潟??筝??????障????膣?膕?????腱?/span>
108 var outMajor : DWORD; // ?<?吾?c?若???若?吾?с??/span>
109 var outMinor : DWORD; // ???ゃ???若???若?吾?с??/span>
110 var outRelease : PChar; // ?????若?号?????
111 var outRevision : DWORD // ?????吾?с?潟???潟????/span>
112 ); stdcall;
113 begin
114
115 {$IFDEF DEBUG}
116 Writeln('ExternalBoardManager.VersionInfo');
117 {$ENDIF}
118 outAgent := CreateResultString( PChar( APP_NAME ) );
119 outMajor := 1;
120 outMinor := 0;
121 outRelease := CreateResultString( PChar( BETA_VERSION_NAME_E ) );
122 outRevision := BETA_VERSION;
123
124 end;
125
126 // *************************************************************************
127 // ?<???祉?若?吾??茵?ず????
128 // *************************************************************************
129 procedure InternalPrint(
130 inMessage : PChar // ?<???祉?若??/span>
131 ); stdcall;
132 begin
133
134 GikoForm.AddMessageList( inMessage, nil, gmiWhat );
135
136 end;
137
138 // *************************************************************************
139 // ???????違?<???祉?若?吾??茵?ず????
140 // *************************************************************************
141 procedure InternalDebugPrint(
142 inMessage : PChar // ?<???祉?若??/span>
143 ); stdcall;
144 begin
145
146 {$IFDEF DEBUG}
147 Writeln( inMessage );
148 {$ENDIF}
149
150 end;
151
152 // *************************************************************************
153 // ?純?宴????????????????(?????∽??
154 // *************************************************************************
155 procedure InitializeSocket(
156 inSocket : TIdHTTP
157 );
158 begin
159
160 if inSocket <> nil then begin
161 // ?ゃ???潟????┃絎?
162 if Assigned( OnWork ) then
163 inSocket.OnWork := OnWork;
164 if Assigned( OnWorkBegin ) then
165 inSocket.OnWorkBegin := OnWorkBegin;
166 if Assigned( OnWorkEnd ) then
167 inSocket.OnWorkEnd := OnWorkEnd;
168
169 // ??篆<???≪????荐??
170 inSocket.Request.CustomHeaders.Clear;
171 inSocket.Response.Clear;
172 inSocket.Request.Clear;
173
174 inSocket.Request.UserAgent := GikoSys.GetUserAgent;
175 inSocket.RecvBufferSize := Gikosys.Setting.RecvBufferSize;
176 inSocket.ProxyParams.BasicAuthentication := False;
177 {$IFDEF DEBUG}
178 Writeln('------------------------------------------------------------');
179 {$ENDIF}
180 //inSocket.AllowCookies := False;
181 if GikoSys.Setting.ReadProxy then begin
182 if GikoSys.Setting.ProxyProtocol then
183 inSocket.ProtocolVersion := pv1_1
184 else
185 inSocket.ProtocolVersion := pv1_0;
186 inSocket.ProxyParams.ProxyServer := GikoSys.Setting.ReadProxyAddress;
187 inSocket.ProxyParams.ProxyPort := GikoSys.Setting.ReadProxyPort;
188 inSocket.ProxyParams.ProxyUsername := GikoSys.Setting.ReadProxyUserID;
189 inSocket.ProxyParams.ProxyPassword := GikoSys.Setting.ReadProxyPassword;
190 if GikoSys.Setting.ReadProxyUserID <> '' then
191 inSocket.ProxyParams.BasicAuthentication := True;
192 {$IFDEF DEBUG}
193 Writeln('???????決┃絎?????');
194 Writeln('???鴻??: ' + GikoSys.Setting.ReadProxyAddress);
195 Writeln('???若??: ' + IntToStr( GikoSys.Setting.ReadProxyPort ));
196 {$ENDIF}
197 end else begin
198 if GikoSys.Setting.Protocol then
199 inSocket.ProtocolVersion := pv1_1
200 else
201 inSocket.ProtocolVersion := pv1_0;
202 inSocket.ProxyParams.ProxyServer := '';
203 inSocket.ProxyParams.ProxyPort := 80;
204 inSocket.ProxyParams.ProxyUsername := '';
205 inSocket.ProxyParams.ProxyPassword := '';
206 {$IFDEF DEBUG}
207 Writeln('???????決┃絎?????');
208 {$ENDIF}
209 end;
210 end;
211
212 end;
213
214 // *************************************************************************
215 // ??絎????? URL ???????潟???若?????????
216 // *************************************************************************
217 function InternalDownload(
218 inURL : PChar; // ?????潟???若?????? URL
219 var ioModified : Double; // ??緇??????????ユ??
220 var outResultData : PChar; // ?????潟???若??????????絖???
221 inRangeStart : DWORD; // ??紮?篏?臀?/span>
222 inRangeEnd : DWORD // 腟?篋?篏?臀?/span>
223 ) : Longint; stdcall; // ???鴻???潟?鴻?潟?若??
224 var
225 httpSocket : TIdHTTP;
226 resStream : TMemoryStream;
227 content : string;
228 begin
229
230 {$IFDEF DEBUG}
231 Writeln('ExternalBoardManager.InternalDownload');
232 {$ENDIF}
233 Result := -1;
234
235 httpSocket := TIdHTTP.Create( nil );
236 try
237 InitializeSocket( httpSocket );
238
239 httpSocket.Request.ContentRangeStart := inRangeStart;
240 httpSocket.Request.ContentRangeEnd := inRangeEnd;
241 if (ioModified <> 0) and (ioModified <> ZERO_DATE) then
242 httpSocket.Request.LastModified := ioModified - OffsetFromUTC;
243 if inRangeStart = 0 then
244 httpSocket.Request.AcceptEncoding := 'gzip'
245 else
246 httpSocket.Request.AcceptEncoding := '';
247 httpSocket.Request.Accept := 'text/html';
248
249 resStream := TMemoryStream.Create;
250 try
251 try
252 resStream.Clear;
253
254 {$IFDEF DEBUG}
255 Writeln('URL: ' + inURL);
256 {$ENDIF}
257 httpSocket.Get( inURL, resStream );
258 {$IFDEF DEBUG}
259 Writeln('??緇??т?紊?????');
260 {$ENDIF}
261
262 content := GikoSys.GzipDecompress( resStream, httpSocket.Response.ContentEncoding );
263 ioModified := httpSocket.Response.LastModified;
264
265 Result := httpSocket.ResponseCode;
266 if (Length( content ) = 0) and (Result = 206) then
267 Result := 304;
268
269 outResultData := CreateResultString( content );
270 except
271 on E: EIdSocketError do begin
272 ioModified := ZERO_DATE;
273 outResultData := nil;
274 end;
275 on E: EIdConnectException do begin
276 ioModified := ZERO_DATE;
277 outResultData := nil;
278 //Item.ErrText := E.Message;
279 end;
280 on E: Exception do begin
281 {$IFDEF DEBUG}
282 Writeln('??緇??т?紊?????');
283 Writeln('E.Message: ' + E.Message);
284 {$ENDIF}
285 ioModified := ZERO_DATE;
286 outResultData := nil;
287 Result := httpSocket.ResponseCode;
288 //Item.ErrText := E.Message;
289 end;
290 end;
291 finally
292 resStream.Free;
293 end;
294
295 finally
296 httpSocket.Free;
297 end;
298
299 end;
300
301 // *************************************************************************
302 // ??絎????? URL ?吾???若?帥????篆<????
303 // *************************************************************************
304 function InternalPost(
305 inURL : PChar; // ??篆<???? URL
306 inSource : PChar; // ??篆<??????絎?/span>
307 var outResultData : PChar // 菴??c????????絖???
308 ) : Longint; stdcall; // ???鴻???潟?鴻?潟?若??
309 var
310 httpSocket : TIdHTTP;
311 content : string;
312 resStream : TStringStream;
313 sourceStream : TStringStream;
314 begin
315
316 {$IFDEF DEBUG}
317 Writeln('ExternalBoardManager.InternalPost');
318 {$ENDIF}
319 Result := -1;
320
321 httpSocket := TIdHTTP.Create( nil );
322 try
323 InitializeSocket( httpSocket );
324
325 httpSocket.Request.CustomHeaders.Add('Pragma: no-cache');
326 httpSocket.Request.AcceptLanguage := 'ja';
327 httpSocket.Request.Accept := 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, */*';
328 httpSocket.Request.ContentType := 'application/x-www-form-urlencoded';
329
330 resStream := TStringStream.Create( content );
331 sourceStream := TStringStream.Create( string( inSource ) );
332 try
333 try
334 {$IFDEF DEBUG}
335 Writeln('URL: ' + inURL);
336 Writeln('Source: ' + inSource);
337 {$ENDIF}
338 httpSocket.Post( string( inURL ), sourceStream, resStream );
339 {$IFDEF DEBUG}
340 Writeln('??緇??т?紊?????');
341 {$ENDIF}
342
343 Result := httpSocket.ResponseCode;
344
345 outResultData := CreateResultString( resStream.DataString );
346 except
347 on E: EIdSocketError do begin
348 outResultData := nil;
349 end;
350 on E: EIdConnectException do begin
351 outResultData := nil;
352 end;
353 on E: Exception do begin
354 {$IFDEF DEBUG}
355 Writeln('??緇??т?紊?????');
356 Writeln('E.Message: ' + E.Message);
357 {$ENDIF}
358 outResultData := CreateResultString( resStream.DataString );
359 Result := httpSocket.ResponseCode;
360 end;
361 end;
362 finally
363 resStream.Free;
364 sourceStream.Free;
365 end;
366 finally
367 httpSocket.Free;
368 end;
369
370 end;
371
372 // *************************************************************************
373 // 鐚??<????????? dat 綵√??????若???????若??????????
374 // *************************************************************************
375
376 function InternalAbon(
377 inDatText : PChar; // ????<>?<?若??lt;>?ヤ?ID<>????<>[?壕?] ?ф??????????????鴻??
378 inDatPath : PChar // dat ???<?ゃ????????????/span>
379
380 ) : PChar; stdcall; // ???若????羝??帥? dat 綵√??????鴻??
381 var
382 datList : TStringList;
383 FileName : String;
384 begin
385
386 datList := TStringList.Create;
387 datList.Text := string( inDatText );
388 FileName := string( inDatPath );
389 GikoSys.FAbon.IndividualAbon( datList, ChangeFileExt(FileName,'.NG'));
390 GikoSys.FAbon.Execute( datList );
391 GikoSys.FSelectResFilter.Execute( datList );
392
393 Result := CreateResultString( datList.Text );
394
395 end;
396 // *************************************************************************
397 // 鐚??<????????? dat 綵√??????若???????若??????????
398 // ????????鐚????鴻????/span>
399 // *************************************************************************
400
401 function InternalAbonForOne(
402 inDatText : PChar; // ????<>?<?若??lt;>?ヤ?ID<>????<>[?壕?] ?ф??????????????鴻??
403 inDatPath : PChar; // dat ???<?ゃ????????????/span>
404 inNo : Integer // 荀?羆??????????合???/span>
405 ) : PChar; stdcall; // ???若????羝??帥? dat 綵√??????鴻??
406 var
407 datString : String;
408 FileName : String;
409 begin
410
411 datString := string( inDatText );
412 FileName := string( inDatPath );
413 GikoSys.FAbon.IndividualAbon( datString, ChangeFileExt(FileName,'.NG'), inNo);
414 GikoSys.FAbon.Execute( datString , inNo);
415 GikoSys.FSelectResFilter.Execute( datString , inNo );
416
417 Result := CreateResultString( datString );
418
419 end;
420
421 // *************************************************************************
422 // 鐚??<????????? dat 綵√? 1 茵??? HTML ?????????
423 // *************************************************************************
424 function InternalDat2HTML(
425 inDatRes : PChar; // ????<>?<?若??lt;>?ヤ?ID<>????<> ?ф??????????????鴻??
426 inResNo : DWORD; // ???合???/span>
427 inIsNew : Boolean // ?亥?????鴻???? True
428 ) : PChar; stdcall; // ?翫就?????? HTML
429 var
430 board : TBoard;
431 threadItem : TThreadItem;
432 begin
433
434 // ?????若????????/span>
435 board := TBoard.Create( nil, 'about://dummy/' );
436 threadItem := TThreadItem.Create( nil, 'about://dummy/test/read.cgi/dummy/' );
437 try
438 try
439 board.Add( threadItem );
440
441 Result := ThreadItemDat2HTML( DWORD( threadItem ), inDatRes, inResNo, inIsNew );
442 except
443 Result := nil;
444 end;
445 finally
446 board.Free;
447 end;
448
449 end;
450
451 // *************************************************************************
452 // ?????違?ゃ?潟?<???ャ?若????????菴遵??
453 // *************************************************************************
454 function AddPlugInMenu(
455 inInstance : DWORD; // ?????違?ゃ?潟???ゃ?潟?鴻?帥?潟??/span>
456 inCaption : PChar // ?<???ャ?若??;腓冴??????絖???
457 ) : HMENU; stdcall; // ?<???ャ?若??潟??????菴遵????け???????翫??? NULL
458 var
459 newItem : TMenuItem;
460 begin
461
462 try
463 newItem := TMenuItem.Create( nil );
464 newItem.Caption := inCaption;
465 newItem.Tag := inInstance;
466 newItem.OnClick := GikoForm.OnPlugInMenuItem;
467 GikoForm.PlugInMenu.Add( newItem );
468
469 Result := newItem.Handle;
470 except
471 Result := 0;
472 end;
473
474 end;
475
476 // *************************************************************************
477 // ?????違?ゃ?潟?<???ャ?若??????????????/span>
478 // *************************************************************************
479 procedure RemovePlugInMenu(
480 inHandle : HMENU // ?<???ャ?若??潟????/span>
481 ); stdcall;
482 var
483 i : Integer;
484 begin
485
486 for i := GikoForm.PlugInMenu.Count - 1 downto 0 do begin
487 if GikoForm.PlugInMenu.Items[ i ].Handle = inHandle then begin
488 GikoForm.PlugInMenu.Delete( i );
489 Break;
490 end;
491 end;
492
493 end;
494
495 exports
496 CreateResultString,
497 DisposeResultString,
498 VersionInfo,
499 InternalPrint,
500 InternalDebugPrint,
501 InternalDownload,
502 InternalPost,
503 InternalAbon,
504 InternalAbonForOne,
505 InternalDat2HTML,
506 AddPlugInMenu,
507 RemovePlugInMenu;
508
509 end.

Back to OSDN">Back to OSDN
ViewVC Help
Powered by ViewVC 1.1.26