home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Peter Lewis / PNL Libraries / MyVersionResource.p < prev    next >
Encoding:
Text File  |  1994-09-08  |  1.4 KB  |  75 lines  |  [TEXT/PJMM]
  1. unit MyVersionResource;
  2.  
  3. interface
  4.  
  5. {$IFC undefined THINK_Pascal}
  6.     uses
  7.         Types;
  8. {$ENDC}
  9.  
  10.     type
  11.         versionRecord = packed record
  12.                 version: integer;
  13.                 devcode: byte;
  14.                 revision: byte;
  15.                 country: integer;
  16.                 short: str15;
  17.                 long: str255;
  18.                 name: str63;
  19.             end;
  20.  
  21.     procedure GetVersion (var vers: versionRecord);
  22.     procedure SetVersionParamText (c3: str255);
  23.  
  24. implementation
  25.  
  26.     uses
  27. {$IFC undefined THINK_Pascal}
  28.         Resources, Memory, Dialogs, 
  29. {$ENDC}
  30.         MyStrings;
  31.  
  32.     procedure GetVersion (var vers: versionRecord);
  33.         var
  34.             vh: handle;
  35.             p: integer;
  36.     begin
  37.         with vers do begin
  38.             vh := GetResource('vers', 1);
  39.             if vh = nil then begin
  40.                 version := $0000;
  41.                 devcode := $20;
  42.                 revision := $00;
  43.                 country := 0;
  44.                 short := '0.0.0';
  45.                 long := 'Unknown v0.0.0';
  46.             end
  47.             else begin
  48.                 BlockMove(vh^, @vers, sizeof(vers));
  49.                 BlockMove(Ptr(longint(vh^) + (longint(@short) - longint(@vers)) + length(short) + 1), @long, sizeof(long));
  50.                 if length(short) >= sizeof(short) then
  51. {$PUSH}
  52.  {$R-}
  53.                     short[0] := chr(sizeof(short) - 1);
  54. {$POP}
  55.                 ReleaseResource(vh);
  56.             end;
  57.             p := pos(short, long);
  58.             while (p > 0) & (vers.long[p] <> ' ') do
  59.                 p := p - 1;
  60.             p := p - 1;
  61.             if p < 1 then
  62.                 p := 255;
  63.             name := TPcopy(vers.long, 1, p);
  64.         end;
  65.     end;
  66.  
  67.     procedure SetVersionParamText (c3: str255);
  68.         var
  69.             vers: versionRecord;
  70.     begin
  71.         GetVersion(vers);
  72.         ParamText(vers.short, vers.long, vers.name, c3);
  73.     end;
  74.  
  75. end.