home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Simtel MSDOS - Coast to Coast
/
simteldosarchivecoasttocoast.iso
/
pcmag
/
vol12n01.zip
/
GROUP.ZIP
/
GROUPFIL.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1992-09-25
|
8KB
|
303 lines
{$R-}
UNIT GroupFile;
(**) INTERFACE (**)
{$IFDEF VER70}
{$Q-}
USES Objects,
{$ELSE}
USES WObjects,
{$ENDIF}
WinTypes, WinProcs, Strings, GroupType;
{$R GROUPFIL.RES}
{$I GROUPFIL.INC}
TYPE
PGroupFile = ^TGroupFile;
TGroupFile = OBJECT(TObject)
{This object only implements methods to get group file info that
I consider IMPORTANT. You can always create a descendant and
add methods to, for example, get the wBitsPerPixel field, or
*write* data back to the GRP file.}
F : File; {Note that F is opened in the
Constructor and not closed 'til the
Destructor}
PGH : PGroupHeader;
HdrSize, Status : Word;
TagDir, TagHot : rgiItemType;
TagMin : ARRAY[0..49] OF Boolean;
CONSTRUCTOR Init(PName : PChar);
DESTRUCTOR Done; Virtual;
FUNCTION CalcCkSum : Word;
FUNCTION GetStatus : Word;
FUNCTION GetStatStr(P : PChar; MaxLen : Word) : PChar;
PROCEDURE ClearStatus;
FUNCTION cIdOk : Boolean;
FUNCTION fwCheckSum : Word;
FUNCTION fcbGroup : Word;
FUNCTION fnCmdShow : Word;
FUNCTION frcNormal : PRect;
FUNCTION fptMin : PPoint;
FUNCTION fcItems : Word;
FUNCTION PCharFmOffset(Offset : Word; P : PChar; MaxLen :
Word) : PChar;
FUNCTION fpName(P : PChar; MaxLen : Word) : PChar;
FUNCTION GetNthItem(N : Word; VAR TID : TItemData) : Boolean;
FUNCTION GetItemTagMin(Item : Word) : Boolean;
FUNCTIOn GetItemTagDir(Item : Word; P : PChar; MaxLen : Word) :
Boolean;
FUNCTION GetItemTagHot(Item : Word; VAR HotKey : Word) : Boolean;
FUNCTION GetItemTagHotStr(Item : Word; P : PChar; MaxLen :
Word) : Boolean;
END;
(**) IMPLEMENTATION (**)
CONSTRUCTOR TGroupFile.Init(PName : PChar);
VAR
dirPos, W : Word;
I : Integer;
TID : TItemData;
TTD : TTagData;
BEGIN
Status := msg_Ok;
{First read and verify fixed-size portion of header}
HdrSize := SizeOf(TGroupHeader) - SizeOf(rgiItemType);
GetMem(PGH, HdrSize);
FillChar(PGH^, HdrSize, 0);
Assign(F, PName);
{$I-} Reset(F, 1); {$I+}
I := IOresult;
IF I <> 0 THEN
BEGIN
Status := msg_OpenFileFailed;
FillChar(PGH^, HdrSize, 0);
Exit;
END;
BlockRead(F, PGH^, HdrSize);
IF NOT cIdOk THEN
BEGIN
Status := msg_NotGRPFile;
FillChar(PGH^, HdrSize, 0);
Exit;
END;
IF CalcCkSum <> 0 THEN
BEGIN
Status := msg_CheckSumBad;
Exit;
END;
W := PGH^.cItems;
FreeMem(PGH, HdrSize);
{Now calculate actual header size and re-read COMPLETE header}
HdrSize := SizeOf(TGroupHeader) - SizeOf(rgiItemType) + 2*W;
GetMem(PGH, HdrSize);
Seek(F, 0);
BlockRead(F, PGH^, HdrSize);
{Fill arrays with tag info for hotkey and dir tags}
FillChar(TagHot, SizeOf(TagHot), 0);
FillChar(TagDir, SizeOf(TagDir), 0);
FillChar(TagMin, SizeOf(TagMin), FALSE);
IF fcbGroup = FileSize(F) THEN Exit;
Seek(F, fcbGroup);
BlockRead(F, TTD, 6);
{First tag should have wID=$8000}
IF TTD.wID <> $8000 THEN
BEGIN
Status := msg_FirstTagBad;
Exit;
END;
BlockRead(F, TTD.rgbString, TTD.cb-6);
REPEAT
{Read fixed-size portion of tag, including actual size in cb}
BlockRead(F, TTD, 6);
IF TTD.wID <> $FFFF THEN
BEGIN
{read remainder of tag data}
DirPos := FilePos(F);
BlockRead(F, TTD.rgbString, TTD.cb-6);
CASE TTD.wID OF
$8101 : TagDir[TTD.wItem] := DirPos;
$8102 : TagHot[TTD.wItem] := TTD.rgbShortcut;
$8103 : TagMin[TTD.wItem] := TRUE;
ELSE
Status := msg_TagBad;
Exit;
END;
END;
UNTIL TTD.wID = $FFFF;
END;
DESTRUCTOR TGroupFile.Done;
BEGIN
FreeMem(PGH, HdrSize);
{$I-} Close(F); {$I+}
IF IOresult <> 0 THEN {tough!};
TObject.Done;
END;
FUNCTION TGroupFile.GetStatus : Word;
BEGIN
GetStatus := Status;
END;
FUNCTION TGroupFile.GetStatStr(P : PChar; MaxLen : Word) : PChar;
BEGIN
LoadString(hInstance, Status, P, MaxLen);
GetStatStr := P;
END;
PROCEDURE TGroupFile.ClearStatus;
BEGIN
Status := msg_Ok;
END;
FUNCTION TGroupFile.CalcCkSum : Word;
{if value of wCheckSum field of header is correct, this
function returns 0}
TYPE BuffType = ARRAY[0..32760] OF Word;
VAR
FB : ^BuffType;
CSum, N, FS : Word;
BEGIN
FS := FileSize(F);
GetMem(FB, FS);
Seek(F, 0);
BlockRead(F, FB^, FS);
CSum := 0;
FOR N := 0 TO pred(FS DIV 2) DO Inc(CSum, FB^[N]);
CalcCkSum := cSum;
FreeMem(FB, FS);
END;
FUNCTION TGroupFile.cIdOk : Boolean;
BEGIN
cIdOk := StrLComp(PGH^.cIdentifier, 'PMCC', 4) = 0;
END;
FUNCTION TGroupFile.fwCheckSum : Word;
BEGIN
fwCheckSum := PGH^.wCheckSum;
END;
FUNCTION TGroupFile.fcbGroup : Word;
BEGIN
fcbGroup := PGH^.cbGroup;
END;
FUNCTION TGroupFile.fnCmdShow : Word;
BEGIN
fnCmdShow := PGH^.nCmdShow;
END;
FUNCTION TGroupFile.frcNormal : PRect;
BEGIN
frcNormal := @PGH^.rcNormal;
END;
FUNCTION TGroupFile.fptMin : PPoint;
BEGIN
fptMin := @PGH^.ptMin;
END;
FUNCTION TGroupFile.fcItems : Word;
BEGIN
fcItems := PGH^.cItems;
END;
FUNCTION TGroupFile.PCharFmOffset(Offset : Word; P : PChar;
MaxLen : Word) : PChar;
{Reads MaxLen bytes from the file F at the specified offset
into the PChar P; returns P}
VAR Actual : Word;
BEGIN
{$I-}
Seek(F, Offset);
BlockRead(F, P^, MaxLen, Actual);
{$I+}
IF IOresult <> 0 THEN
BEGIN
P[0] := #0;
Status := msg_ReadStrFailed;
END;
PCharFmoffset := P
END;
FUNCTION TGroupFile.fPName(P : PChar; MaxLen : Word) : PChar;
BEGIN
fPName := PCharFmOffset(PGH^.pName, P, MaxLen);
END;
FUNCTION TGroupFile.GetNthItem(N : Word; VAR TID : TItemData) :
Boolean;
{Valid for N from 0 to PGH^.cItems-1. If Nth item exists,
reads it into TID and returns TRUE; else FALSE.}
BEGIN
IF PGH^.rgiItems[N] <> 0 THEN
BEGIN
GetNthItem := TRUE;
{$I-}
Seek(F, PGH^.rgiItems[N]);
BlockRead(F, TID, SizeOf(TID));
{$I+}
IF IOResult <> 0 THEN
BEGIN
GetNthItem := FALSE;
Status := msg_BadItem;
END;
END
ELSE GetNthItem := FALSE;
END;
FUNCTION TGroupFile.GetItemTagMin(Item : Word) : Boolean;
BEGIN
GetItemTagMin := TagMin[Item];
END;
FUNCTION TGroupFile.GetItemTagDir(Item : Word; P : PChar;
MaxLen : Word) : Boolean;
{If a directory tag for the item exists, returns TRUE and puts
the directory into PChar P; else returns FALSE}
BEGIN
IF TagDir[Item] <> 0 THEN
BEGIN
GetItemTagDir := TRUE;
PCharFmOffset(TagDir[Item], P, MaxLen);
END
ELSE GetItemTagDir := FALSE;
END;
FUNCTION TGroupFile.GetItemTagHot(Item : Word; VAR HotKey : Word) :
Boolean;
{If a hotkey for the item exists, returns TRUE and puts hotkey
value in the HotKey argument; else returns FALSE}
BEGIN
IF TagHot[Item] <> 0 THEN
BEGIN
GetItemTagHot := TRUE;
HotKey := TagHot[Item];
END
ELSE GetItemTagHot := FALSE;
END;
FUNCTION TGroupFile.GetItemTagHotStr(Item : Word; P : PChar;
MaxLen : Word) : Boolean;
{If a hotkey for the item exists, returns TRUE and puts a string
describing the hotkey into PChar P; else returns FALSE}
VAR
HK : Word;
chBuff : ARRAY[0..1] OF Char;
BEGIN
IF GetItemTagHot(Item, HK) THEN
BEGIN
GetItemTagHotStr := TRUE;
P[0] := #0;
IF Hi(HK) AND 2 = 2 THEN StrLCat(P, 'Ctrl+', MaxLen);
IF Hi(HK) AND 1 = 1 THEN StrLCat(P, 'Shift+', MaxLen);
IF Hi(HK) AND 4 = 4 THEN StrLCat(P, 'Alt+', MaxLen);
chBuff[0] := Char(Lo(HK));
chBuff[1] := #0;
StrLCat(P, chBuff, MaxLen);
END
ELSE GetItemTagHotStr := FALSE;
END;
END.