Приложение 2. Листинги модулей для создания системы помощи. Kylix - система быстрой разработки приложений для ОС LINUX

Здесь представлены листинги модулей для создания системы помощи.

Листинг П2.1. Модуль WinHelpViewer. pas
unit WinHelpViewer;
{**********************************************************************************}
{ }
( Этот модуль обеспечивает поддержку просмотрщика помощи WinHelp (под
{ Windows) или HyperHelp (эмулятор WinHelp) под Linux.}
{ }
{ **********************************************************************************}
interface
uses Classes;
type
IWinHelpTester = interface(Ilnterface)
['{BOFC9354-5FOE-11D3-A3B9-00C04F79AD3A)']
function CanShowALink(const ALink, FileName: String): Boolean;
function CanShowTopic(const Topic, FileName: String): Boolean;
function CanShowContext(const Context: Integer;
const FileName: String): Boolean;
function GetHelpStrings(const ALink: String): TStringList;
function GetHelpPath : String;
function GetDefaultHelpFile: String;
end;
var
WinHelpTester : IWinHelpTester;
ViewerName : String;
{$IFDEF LINUX}
HyperHelpWindowName : String;
{$ENDIF}
{=========================================================================}
implementation
($IFDEF MSWINDOWS}
uses Helplntfs, SysUtils, Windows;
{$ENDIF}
{$IFDEF LINUX}
uses Helplntfs, SysUtils, Libc;
{$ENDIF}
($IFDEF LINUX)
const
winhelpmodulename = 'winhelp.so';
function WinHelp(HWND: Longlnt; HelpFile: PChar; Command: Longlnt;
Data: LongWord): Boolean; cdecl;
external winhelpmodulename name 'WinHelp';
($ENDIF}
type
TWinHelpViewer = class(TInterfacedobject, ICustomHelpViewer, lExtended-HelpViewer, ISpecialWinHelpViewer)
private
FViewerlD: Integer;
public
FHelpManager: IHelpManager;
constructor Create;
function HelpFile(const Name: String) : String;
procedure InternalShutDown;
{ ICustomHelpViewer }
function GetViewerName : String;
function UnderstandsKeyword(const HelpString: String): Integer;
function GetHelpStrings(const HelpString: String): TStringList;
function CanShowTableOfContents: Boolean;
procedure ShowTableOfContents;
procedure ShowHelp(const HelpString: String);
procedure NotifylD(const ViewerlD: Integer);
procedure SoftShutDown;
procedure ShutDown;
{ lExtendedHelpViewer }
function UnderstandsTopic(const Topic: String): Boolean;
procedure DisplayTopic(const Topic: String);
function UnderstandsContext(const ContextID: Integer;
const HelpFileName: String): Boolean;
procedure DisplayHelpByContext(const ContextID: Integer;
const HelpFileName: String);
( ISpecialWinHelpViewer }
function CallWinHelp(Handle: Longlnt; const HelpFileName: String;
Command: Word; Data: Longlnt) : Boolean;
property ViewerlD : Integer read FViewerlD;
property HelpManager : IHelpManager read FHelpManager write FHelpManager;
destructor Destroy; override;
end;
var
HelpViewer : TWinHelpViewer;
{---------------------------------------------------------------------------------------------------------------------------}
{ TWinHelpViewer }
constructor TWinHelpViewer.Create;
begin
inherited Create;
end;
function TWinHelpViewer.HelpFile(const Name: String): String;
var
FileName : String;
begin
Result := " ;
if (Name = '') and Assigned(FHelpManager) then
FileName := HelpManager.GetHelpFile
else FileName := Name;
if FileName = '' then
if Assigned(WinHelpTester) then
FileName := WinHelpTester.GetDefaultHelpFile;
{$IFDEF LINUX}
if Assigned(WinHelpTester) then
FileName := WinHelpTester.GetHelpPath + PathDelim + FileName;
{$ENDIF}
Result := FileName;
end;
procedure TWinHelpViewer.InternalShutDown;
begin
SoftShutDown;
if Assigned(FHelpManager) then
begin
HelpManager.Release(ViewerlD);
if Assigned(FHelpManager) then HelpManager := nil;
end;
end;
{-------------------------------------------------------------------------------------------------------------------------------}
{ TWinHelpViewer - ICustomHelpViewer }
function TWinHelpViewer.GetViewerName : String;
begin
Result := ViewerName;
end;
function TWinHelpViewer.UnderstandsKeyword(const HelpString: String):
Integer;
var
CanShowHelp : Boolean;
begin
if Assigned(WinHelpTester) then
begin
CanShowHelp := WinHelpTester.CanShowALink(HelpString, HelpFile(''));
if CanShowHelp then Result := 1
else Result := 0;
end
else begin
{$IFDEF WINDOWS}
Result := 1;
{$ENDIF}
{$IFDEF LINUX}
Result := 0;
{$ENDIF}
end;
end;
function TWinHelpViewer.GetHelpStrings(const HelpString: String):
TStringList;
begin
if Assigned(WinHelpTester) then
begin
Result := WinHelpTester.GetHelpStrings(HelpString);
end else
begin
Result := TStringList.Create;
{$IFDEF MSWINDOWS}
Result.Add(GetViewerName + ': ' + , HelpString);
{SENDIF}
end;
end;
function TWinHelpViewer.CanShowTableOfContents : Boolean;
begin
Result := true;
end;
procedure TWinHelpViewer.ShowTableOfContents;
begin
WinHelp(HelpManager.GetHandle, PChar(HelpFile(HelpManager.GetHelpFile)
HELP_CONTENTS, 0);
end;
{$IFDEF MSWINDOWS}
procedure TWinHelpViewer.ShowHelpfconst HelpString: String);
const
Macro = 4E(AL("%s",4),"AL(\"%0:s\",3)","JK(\"%l:s\",\"%0:s\")")';
begin
WinHelp(HelpManager.GetHandle, PChar(HelpFile('')), HELP_COMMAND,
Longlnt(PChar(Format(Macro, [HelpString, HelpFile(")]))));
end;
{$ENDIF}
($IFDEF LINUX}
procedure TWinHelpViewer.ShowHelp(const HelpString: String);
const
Macro = 'AL(%Os,3,,%ls)';
begin
WinHelp(HelpManager.GetHandle, PChar(HelpFile('')), HELP_COMMAND,
Longlnt(Pchar(Format(Macro, [HelpString, HyperHelpWindowName]))));
end;
{$ENDIF}
procedure TWinHelpViewer.NotifylD(const ViewerlD: Integer);
begin
FViewerlD := ViewerlD;
end;
procedure TWinHelpViewer.SoftShutDown;
begin
WinHelp(0, PChar(''), HELP_QUIT, 0);
end;
procedure TWinHelpViewer.ShutDown;
begin
SoftShutDown;
if Assigned(FHelpManager) then HelpManager := nil;
if Assigned(WinHelpTester) then WinHelpTester := nil;
end;
{--------------------------------------------------------------------------------------------------------------------}
{ TWinHelpViewer --- lExtendedHelpViewer }
function TWinHelpViewer.UnderstandsTopic(const Topic: String): Boolean;
begin
{5IFDEF MSWINDOWS}
Result := true;
{$ENDIF}
{$IFDEF LINUX)
Result := false;
{$ENDIF}
if Assigned(WinHelpTester} then
Result := WinHelpTester.CanShowTopic(Topic, HelpFile(''));
end;
procedure TWinHelpViewer.DisplayTopic(const Topic: String);
var
HelpCommand: array[0..255 of Char;
begin
StrLFmt(HelpCommand, SizeOf(HelpCommand) -I, 'JumpID("","%s")', [Topic]);
WinHelp(HelpManager.GetHandle, PChar(HelpFile('')), HELP_COMMAND,
Longint(@HelpCommand));
end;
function TWinHelpViewer.UnderstandsContext(const ContextID: Integer;
const HelpFileName: String): Boolean;
begin
{$IFDEF MSWINDOWS}
Result := true;
{$ENDIF}
($IFDEF LINUX}
Result := false;
{$ENDIF}
if Assigned(WinHelpTester) then
Result := WinHelpTester.CanShowContext(ContextID, Help-File (HelpFileName));
end;
procedure TWinHelpViewer.DisplayHelpByContext(const ContextID: Integer;
const HelpFileName: String);
begin
WinHelpfHelpManager.GetHandle, PChar(HelpFile(HelpFileName)),
HELP_CONTEXT, ContextID);
end;
{----------------------------------------------------------------------------------------------------------------}
{ TWinHelpViewer --- ISpecialWinHelpViewer }
function TWinHelpViewer.CallWinHelp(Handle: Longlnt; const HelpFileName: String;
Command: Word; Data: Longlnt) : Boolean;
begin
Result := WinHelp(Handle, PChar(HelpFile(HelpFileName)), Command, Data);
end;
destructor TWinHelpViewer.Destroy;
begin
inherited Destroy;
end;
{==================================================================================}
initialization
HelpViewer := TWinHelpViewer.Create;
Helplntfs.RegisterViewer(HelpViewer, HelpViewer.FHelpManager);
WinHelpTester := nil;
finalization
if Assigned(HelpViewer.FHelpManager) then
begin
HelpViewer.InternalShutDown;
end;
if Assigned(WinHelpTester) then
begin
WinHelpTester := nil;
end;
end.

Листинг П2.2. Модуль Man Viewer, pas
unit ManViewer;
{ ***************************************************************************************************}
{ }
{ Этот модуль поддерживает просмотрщик страниц man в среде Linux. }
{ Он не был опробован на различных unix-системах и формах Linux, }
{ за исключением RedHat. }
{ }
{ ********************************************************************* ********************************}
interface
{=====================================================================}
implementation
uses Helplntfs, Classes, SysUtils, LibC;
type
TManPageViewer = class(TlnterfacedObject, ICustomHelpViewer)
private
FHelpStrings : TStringList;
FLastQuery : String;
FViewerlD : Integer;
ChildPid : Integer;
procedure ProcessHelpStrings(StringBuf: PChar; HelpString: String);
procedure KillChild;
public
FHelpManager : IHelpManager;
constructor Create;
procedure InternalShutDown;
{ ICustomHelpViewer }
function GetViewerName : String;
function UnderstandsKeyword(const HelpString: String): Integer;
function GetHelpStrings(const HelpString: String): TStringList;
function CanShowTableOfContents : Boolean;
procedure ShowHelp(const HelpString: String);
procedure ShowTableOfContents;
procedure NotifyID(const ViewerlD: Integer);
procedure SoftShutDown;
procedure ShutDown;
property HelpManager : IHelpManager read FHelpManager write FHelpManager;
property ViewerlD : Integer read FViewerlD;
destructor Destroy; override;
end;
var
HelpViewer : TManPageViewer;
const
{ man and its switches }
ExeName = 'man';
AllSwitch = '-a'; { отображает все man-страницы раздела }
WhereSwitch = '-w'; { где располагается man-страница? }
ViewerName = 'xterm';
MoreBugSwitch = '-cu';
ExecSwitch = '-e';
TitleSwitch = '-Т'; {установка заголовка окна }
ViewerTitle = 'Kylix man page viewer';
{ сигнал, используемый для завершения дочерних процессов }
KillSignal = SIGINT;
sFatalFork = 'Unable to fork(). Please consult the disaster manual.';
sNoTableOfContents = 'Unable to provide table of contents for man pages. ' ;
{--------------------------------------------------------------------------------------------------------------------------------------------------}
{ TManPageViewer }
constructor TManPageViewer.Create;
begin
inherited Create;
end;
procedure TManPageViewer.ProcessHelpStrings(StringBuf: PChar;
HelpString: String);
var
bufptr, lineptr, valptr, delim: PChar;
searching: boolean;
addstr : String;
begin
bufptr := StringBuf;
searching := true;
while searching do
begin
delim := #10#13;
lineptr := strsep(@bufptr, delim);
if (lineptr = nil) then
begin
searching := false;
end else
begin
delim := ' . ' ;
strsep(Slineptr, delim);
valptr := strsep(Slineptr, delim);
if valptr <> nil then
begin
addstr := HelpString + ' (' + valptr + ') (' + GetViewerName + ')';
FHelpStrings.Add(addstr);
end;
end;
end;
end;
procedure TManPageViewer.KillChild;
begin
if ChildPid <> 0 then
begin
kill(ChildPid, KillSignal);
waitpid(ChildPid, nil, WNOHANG or WUNTRACED);
ChildPid := 0;
end;
end;
procedure TManPageViewer.InternalShutDown;
begin
KillChild;
if Assigned(FHelpManager) then FHelpManager.Release(ViewerlD);
ShutDown;
end;
{--------------------------------------------------------------------------------------------------------------------------------------------------------------}
( TManPageViewer --- ICustomHelpViewer }
function TManPageViewer.GetViewerName;
begin
Result := ExeName;
end;
function TManPageViewer.UnderstandsKeyword(const HelpString: String):
Integer;
var
SuccDescr, ErrDescr : TPipeDescriptors;
pid: Integer;
Args : array of PChar;
DescriptorSet : TFDSet;
WaitTime : TTimeVal;
WaitStatus: Integer;
PipeStream : THandleStream;
ReadBuf : Pointer;
BytesRead: Integer;
Reading : Boolean;
begin
Result := 0;
if FHelpStrings <> nil then FHelpStrings := nil;
SetLength(Args, 5);
Args[0] := ExeName;
Args[l] := AllSwitch;
Args[2] := WhereSwitch;
Args[3] := PChar(HelpString);
Args[4] := nil;
pipe(SuccDescr);
pipe(ErrDescr);
pid := fork;
if pid = 0 then
begin
__close(SuccDescr.ReadDes);
__close(ErrDescr.ReadDes);
dup2(SuccDescr.WriteDes, stdout);
dup2(ErrDescr.WriteDes, stderr);
execvp (PChar (Args [ 0 ] ) , @Args [ 0 ].) ;
end
else begin
if pid = -1 then
begin
raise EHelpSystemException.Create(sFatalFork);
end else
begin
WaitStatus := waitpid(pid, nil, WUNTRACED);
if WaitStatus > 0 then
begin
WaitTime.tv sec := 0;
WaitTime.tv_usec := 0;
FD_ZERO(DescriptorSet);
FD_SET(TSocket(SuccDescr.ReadDes), DescriptorSet);
FD_SET(TSocket(ErrDescr.ReadDes), DescriptorSet);
select(__FD_SETSIZE, @DescriptorSet, nil, nil, @WaitTime);
if FD_ISSET(TSocket(SuccDescr.ReadDes), DescriptorSet) then
begin
if FHelpStrings = nil then FHelpStrings := TStringList.Create;
PipeStream := THandleStream.Create(SuccDescr.ReadDes);
ReadBuf := Libc.malloc(1024);
memset(ReadBuf, 0, 1024);
Reading := true;
while Reading do
begin
BytesRead := PipeStream.Read(ReadBuf^, 1024);
if (BytesRead < 1024) then Reading := false;
ProcessHelpStrings (ReadBuf-, HelpString) ;
memset(ReadBuf, 0, 1024);
end;
Libc.free(ReadBuf);
PipeStream.Free;
Result := FHelpStrings.Count;
FLastQuery := HelpString;
end else
begin
end;
end else
begin
if FHelpStrings = nil then FHelpStrings := TStringList.Create;
end;
end;
end;
__close(SuccDescr.WriteDes);
__close(ErrDescr.WriteDes);
__close(SuccDescr.ReadDes);
__close(ErrDescr.ReadDes);
end;
function TManPageViewer.GetHelpStrings(const HelpString: String):
TStringList;
begin
Result := FHelpStrings;
end;
function TManPageViewer.CanShowTableOfContents: Boolean;
begin
Result := false;
end;
procedure TManPageViewer.ShowTableOfContents;
begin
raise EHelpSystemException.Create(sNoTableOfContents);
end;
procedure TManPageViewer.ShowHelp(const HelpString: String);
var
KeywordEnd, Section, CompResult, CompString, Comparator: PChar;
Args : array of PChar;
pid : Integer;
begin
KillChild;
SetLength(Args, 9);
Args[0] := ViewerName;
Args[l] := MoreBugSwitch;
Args[2] := TitleSwitch;
Args[3] := ViewerTitle;
Args[4] := ExecSwitch;
Args[5] := ExeName;
Args[6] := AllSwitch;
Args[7] := PChar(HelpString);
Args[8] := nil;
CompString := PChar(HelpString) ;
Comparator := Libc.malloc(2);
Comparator[0] := ' (' ;
Comparator[1] := #0;
CompResult := strstr(CompString, Comparator);
Libc.free(Comparator);
if (CompResult <> nil) then
begin
Section := Libc.malloc(2) ;
KeywordEnd := AnsiStrPos(PChar(HelpString) , '(');
Section[0] := KeywordEnd[1];
Section[1] := #0;
Args[6] := Section;
{ #DEFINE DUMB_HACK_BY_TIRED_PROGRAMMER }
Args[7] := PChar(FLastQuery);
end
else begin
Section := nil;
end;
pid := fork;
if pid = 0 then
begin
execvp(PChar(Args[0]), @Args[0]);
end
else begin
if pid = -1 then
begin
raise EHelpSystemException.Create(sFatalFork) ;
end
else begin
ChildPid := pid;
end;
end;
if Section <> nil then Libc.free(Section) ;
end;
procedure TManPageViewer.NotifylD(const ViewerlD: Integer);
begin
FViewerlD := ViewerlD;
end;
procedure TManPageViewer.SoftShutDown;
begin KillChild;
end;
procedure TManPageViewer.ShutDown;
begin
KillChild;
if Assigned(FHelpManager) then FHelpManager := nil;
end;
destructor TManPageViewer.Destroy;
begin
inherited Destroy;
end;
{================================================================================}
initialization
if not Assigned(HelpViewer) then
begin
HelpViewer := TManPageViewer.Create;
HelpIntfs.RegisterViewer(HelpViewer, HelpViewer.FHelpManager);
end;
finalization
if Assigned(HelpViewer) then
begin
HelpViewer.InternalShutDown;
end;
end.

Знаете ли Вы, как разрешается парадокс Ольберса?
(Фотометрический парадокс, парадокс Ольберса - это один из парадоксов космологии, заключающийся в том, что во Вселенной, равномерно заполненной звёздами, яркость неба (в том числе ночного) должна быть примерно равна яркости солнечного диска. Это должно иметь место потому, что по любому направлению неба луч зрения рано или поздно упрется в поверхность звезды.
Иными словами парадос Ольберса заключается в том, что если Вселенная бесконечна, то черного неба мы не увидим, так как излучение дальних звезд будет суммироваться с излучением ближних, и небо должно иметь среднюю температуру фотосфер звезд. При поглощении света межзвездным веществом, оно будет разогреваться до температуры звездных фотосфер и излучать также ярко, как звезды. Однако в дело вступает явление "усталости света", открытое Эдвином Хабблом, который показал, что чем дальше от нас расположена галактика, тем больше становится красным свет ее излучения, то есть фотоны как бы "устают", отдают свою энергию межзвездной среде. На очень больших расстояниях галактики видны только в радиодиапазоне, так как их свет вовсе потерял энергию идя через бескрайние просторы Вселенной. Подробнее читайте в FAQ по эфирной физике.