Листинги модулей

для создания системы

помощи

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

Листинг П2.1.Модуль WinHelpViewer.pas

unit WinHelpViewer;
{********************************************************************* }
{ }
{ Этот модуль обеспечивает поддержку просмотрщика помощи WinHelp (под
{ Windows) или HyperHelp (эмулятор WinHelp) под Linux.}
{ }
{********************************************************************* }
interface
uses Classes;
type
IWinHelpTester - interface(IInterface)
['{B0FC9354-5F0E-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}
{====================================================================}
{$IFDEF MSWINDOWS}
uses HelpIntfs, SysUtils, Windows;
{$ENDIF}
{$IFDEF LINUX}
uses HelpIntfs, SysUtils, Libc;
{$ENDIF}
{$IFDEF LINUX}
const
winhelpmodulename = 'winhelp.so';
function WinHelp(HWND: LongInt; HelpFile: PChar; Conmand: LongInt;
Data: LongWord): Boolean; cdecl;
external winhelpmodulename name 'WinHelp';
{$ENDIF}
type
TWinHelpViewer = class(TInterfacedObject, ICustomHelpViewer, IExtended-
HelpViewer, ISpecialWinHelpViewer)
private
FViewerID: Integer;
public
FHelpManager: IHelpManager;
constructor Create;
function HelpFile(const Name: String) : String;
procedure InternalShutDown;
{ ICustoroHelpViewer }
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 NotifуID(const ViewerID: Integer);
procedure SoftShutDown;
procedure ShutDown;
{ IExtendedHelpViewer }
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: LongInt;
const HelpFileName: String;
Command: Word; Data: LongInt) : Boolean;
property ViewerID : Integer read FViewerID;
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(ViewerID);
if Assigned(FHelpManager) then HelpManager := nil;
end;
end;
{----------------------------------------------------------------------}
{ TWinHelpViewer - ICustomHelpViewer }
function TWinHelpViewer.GetViewerNaroe : 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);
{$ENDIF}
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.ShowHelp(const HelpString: String);
const
Macro - 'IE(AL("%s",4),"AL(\"%0:s\",3)","JK(\"%l:s\",\"%0:s\")")';
begin
WinHelp(HelpManager.GetHandle, PChar(HelpFile(" )),/ HELP_COMMAND,
LongInt (PChar (Format (Macro, [HelpString, HelpFile (")]))));
end;
{$ENDIF}
{$IFDEF LINUX}
procedure.TWinHelpViewer.ShowHelp(const HelpString: String);
const
Macro= 'AL(%0s,3,,%ls)';
begin
WinHfelp(HelpManager.GetHandle, PChar(HelpFile(")), HELP_COMMAND,
LongInt(Pchar(Format(Macro, [HelpString, HyperHelpWindowName]))));
end;
{$ENDIF}
procedure TWinHelpViewer.NotifylD(const ViewerID: Integer);
begin
FViewerID := ViewerID;
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 —— IExtendedHelpViewer }
function TWinHelpViewer.UnderstandsTopic(const Topic: String): Boolean;
begin
{$IFDEF MSWINDOWS}
Result := true;
{$EMDIF}
{$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) -1, ' JtmpIDC'", "%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.DisplayHelpfeyContext(const ContextID: Integer;
const HelpFileName: String);
begin
WinHelp(HelpManager.GetHandle, PChar(HelpFile(HelpFileName)),
HELP_CONTEXT, ContextID);
end;
{------------------------------------------------------------------------}
{ TWinHelpViewer —— ISpecialWinHelpViewer }
function TWinHelpViewer.CallWinHelp(Handle: LongInt; const HelpFileName: String;
Command: Word; Data: LongInt) : 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.Модуль ManViewer.pas

unit ManViewer;
{*********************************************************************}
{ }
{ Этот модуль поддерживает просмотрщик страниц man в среде Linux. }
{ Он не был опробован на различных unix-системах и формах Linux, }
{ за исключением RedHat. }
{ }
{ *******************************************************************}
interface
{ = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = }
implementation
uses HelpIntfs, Classes, SysUtils, LibC;
type
TManPageViewer = class(TInterfacedObject, ICustomHelpViewer)
private
FHelpStrings : TStringList;
FLastQuery : String;
FViewerID : 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 ViewerID: Integer);
procedure SoftShutDown;
procedure ShutDown;
property HelpManager : IHelpManager read FHelpManager write FHelpManager;
property ViewerID : Integer read FViewerID;
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(@lineptr, delim);
valptr := strsep(@lineptr, 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. IntemalShutDown;
begin
KillChild;
if Assigned(FHelpManager) then FHelpManager.Release(ViewerID);
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 : TTiraeVal;
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[1 ] = MoreBugSwitch;
Args[2] = TitleSwitch;
Args[3] = ViewerTitle;
Args[4] = ExecSwitch;
Args[5] = ExeName;
Args[6] = AllSwitgh;
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_НАСК_ВУ_ТIRED_РROGRAMMER }
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 EHelpSystemExceptiorv.Create (sFatalFork);
end
else begin
ChildPid := pid;
end;
end;
if Section о nil then Libc.free(Section);
end;
procedure TManPageViewer.NotifyID(const ViewerID: Integer);
begin
FViewerID := ViewerID;
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.