home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1991 / 02 / tricks / message.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-11-06  |  3.2 KB  |  128 lines
  1. (* ------------------------------------------------------ *)
  2. (*                   MESSAGE.PAS                          *)
  3. (*          (c) 1991 Jochen Walz & TOOLBOX                *)
  4. (* ------------------------------------------------------ *)
  5. {$B-,D-,F-,I-,N-,R-,S-,V-}
  6. {$M 65520,0,655360}
  7.  
  8. UNIT Message;
  9.  
  10. INTERFACE
  11.  
  12.   FUNCTION ReturnMessage (number : INTEGER) : STRING;
  13.  
  14.   FUNCTION LocateMessage (header : STRING) : STRING;
  15.  
  16.  
  17. IMPLEMENTATION
  18.  
  19. TYPE
  20.   MessagePointer = ^STRING;
  21.  
  22. VAR
  23.   MessageBuffer : MessagePointer;
  24.   MessageNumber : INTEGER;
  25.  
  26.   FUNCTION ReturnMessage (number : INTEGER) : STRING;
  27.   VAR
  28.     i : INTEGER;
  29.     p : MessagePointer;
  30.  
  31.     FUNCTION CheckSum : STRING;
  32.     VAR
  33.       i1, i2 : INTEGER;
  34.       p      : MessagePointer;
  35.       s      : STRING;
  36.       sum    : INTEGER;
  37.     BEGIN
  38.       sum := 0;
  39.       p   := MessageBuffer;
  40.       FOR i1 := 1 TO MessageNumber-1 DO BEGIN
  41.         p := Ptr(Seg(p^), Ofs(p^)+Length(p^)+1);
  42.         FOR i2 := 0 TO Length(p^) DO
  43.           sum := sum + Ord(p^[i2]);
  44.       END;
  45.       Str(sum, s);
  46.       CheckSum := s;
  47.     END;
  48.  
  49.   BEGIN
  50.     IF (number < 1) THEN
  51.       ReturnMessage := CheckSum
  52.     ELSE IF (number > MessageNumber) THEN
  53.       ReturnMessage := ''
  54.     ELSE BEGIN
  55.       p := MessageBuffer;
  56.       FOR i := 1 TO number-1 DO
  57.         p := Ptr(Seg(p^), Ofs(p^)+Length(p^)+1);
  58.       ReturnMessage := p^;
  59.     END;
  60.   END;
  61.  
  62.    FUNCTION LocateMessage (header : STRING) : STRING;
  63.    VAR
  64.      i : INTEGER;
  65.      p : MessagePointer;
  66.    BEGIN
  67.      p := MessageBuffer;
  68.      FOR i := 1 TO MessageNumber DO BEGIN
  69.        IF (Copy(p^, 1, Length(header)) = header) THEN BEGIN
  70.           LocateMessage := Copy(p^, Length(header)+1,
  71.                                 Length(p^)-Length(header));
  72.           Exit;
  73.        END;
  74.        p := Ptr(Seg(p^), Ofs(p^)+Length(p^)+1);
  75.      END;
  76.      LocateMessage := '';
  77.    END;
  78.  
  79.    PROCEDURE Initialize;
  80.    VAR
  81.      buffer : ARRAY [$0000..$F000] OF CHAR;
  82.      bytes  : WORD;
  83.      line   : STRING;
  84.      source : TEXT;
  85.  
  86.      FUNCTION Specification : STRING;
  87.      VAR
  88.        Offset  : INTEGER;
  89.        Segment : INTEGER;
  90.        s       : STRING;
  91.      BEGIN
  92.        Segment := MemW[PrefixSeg:$002C];
  93.        Offset  := 0;
  94.        WHILE (MemW[Segment:Offset] <> 0) DO
  95.          Offset := Offset + 1;
  96.        Move(Mem[Segment:Offset+3], s, SizeOf(s));
  97.        s[0] := Chr(0);
  98.        WHILE (Length(s) < 255) AND
  99.              (s[Length(s)+1] <> Chr(0)) DO
  100.          s[0] := Succ(s[0]);
  101.        Specification := Copy(s, 1, Length(s)-4) + '.TXT';
  102.      END;
  103.  
  104.    BEGIN
  105.      Assign(source, Specification);
  106.      Reset(source);
  107.      bytes         := 0;
  108.      MessageNumber := 0;
  109.      REPEAT
  110.        IF EoF(source) OR (IOResult <> 0) THEN BEGIN
  111.          Close(source);
  112.          GetMem(MessageBuffer, bytes+1);
  113.          Move(buffer, MessageBuffer^, bytes);
  114.          Exit;
  115.        END;
  116.        ReadLn(source, line);
  117.        Move(line, buffer[bytes], Length(line)+1);
  118.        bytes := bytes + Length(line) + 1;
  119.        MessageNumber := MessageNumber+1;
  120.      UNTIL FALSE;
  121.    END;
  122.  
  123. BEGIN
  124.   Initialize;
  125. END.
  126. (* ------------------------------------------------------ *)
  127. (*                 Ende von MESSAGE.PAS                   *)
  128.