Приложение 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.

Знаете ли Вы, что такое мысленный эксперимент, gedanken experiment?
Это несуществующая практика, потусторонний опыт, воображение того, чего нет на самом деле. Мысленные эксперименты подобны снам наяву. Они рождают чудовищ. В отличие от физического эксперимента, который является опытной проверкой гипотез, "мысленный эксперимент" фокуснически подменяет экспериментальную проверку желаемыми, не проверенными на практике выводами, манипулируя логикообразными построениями, реально нарушающими саму логику путем использования недоказанных посылок в качестве доказанных, то есть путем подмены. Таким образом, основной задачей заявителей "мысленных экспериментов" является обман слушателя или читателя путем замены настоящего физического эксперимента его "куклой" - фиктивными рассуждениями под честное слово без самой физической проверки.
Заполнение физики воображаемыми, "мысленными экспериментами" привело к возникновению абсурдной сюрреалистической, спутанно-запутанной картины мира. Настоящий исследователь должен отличать такие "фантики" от настоящих ценностей.

Релятивисты и позитивисты утверждают, что "мысленный эксперимент" весьма полезный интрумент для проверки теорий (также возникающих в нашем уме) на непротиворечивость. В этом они обманывают людей, так как любая проверка может осуществляться только независимым от объекта проверки источником. Сам заявитель гипотезы не может быть проверкой своего же заявления, так как причина самого этого заявления есть отсутствие видимых для заявителя противоречий в заявлении.

Это мы видим на примере СТО и ОТО, превратившихся в своеобразный вид религии, управляющей наукой и общественным мнением. Никакое количество фактов, противоречащих им, не может преодолеть формулу Эйнштейна: "Если факт не соответствует теории - измените факт" (В другом варианте " - Факт не соответствует теории? - Тем хуже для факта").

Максимально, на что может претендовать "мысленный эксперимент" - это только на внутреннюю непротиворечивость гипотезы в рамках собственной, часто отнюдь не истинной логики заявителя. Соответсвие практике это не проверяет. Настоящая проверка может состояться только в действительном физическом эксперименте.

Эксперимент на то и эксперимент, что он есть не изощрение мысли, а проверка мысли. Непротиворечивая внутри себя мысль не может сама себя проверить. Это доказано Куртом Гёделем.

Понятие "мысленный эксперимент" придумано специально спекулянтами - релятивистами для шулерской подмены реальной проверки мысли на практике (эксперимента) своим "честным словом". Подробнее читайте в FAQ по эфирной физике.