Program SourceRetter;

{$path"ram:include/","pascal:include/"}
{$include "libraries/dos.h","exec/execbase.h"}

Const
 MinExtMem=$c00000;

Type
 Kennung=Record
  s:string[14];
  Zahl1,Zahl2:integer;
  Anfang,Ende: Long
 End;

Var
 Base: ^ExecBase;

Procedure WriteHex(L:Long);
  Var i,z:integer;
      d:Long;
  Begin
    d:=$100000;
    L:=L mod(16*d);
    write('$');
    For i:=1 to 6 Do
      Begin
        z:=L div d;
        L:=L mod d;
        if z<10 then write(chr(ord('0')+z))
                else write(chr(ord('a')+z-10));
        d:=d div 16
      End
  End;

Procedure SaveMemory(a,e:Long);
  Var Name:string[80];
      i:Long;
      fi: BPTR;

  Begin
    Repeat
      write('Filename: '); readln(Name);
      If Name<>'' Then
        Begin
          fi:=Open(Name,MODE_NEWFILE);
          If fi=0 Then
            writeln('File Error!')
          Else
            Begin
              writeln('Saving...');
              i:=_Write(fi,Ptr(a),e-a);
              _Close(fi);
              If i=e-a Then name:=''   { OK }
              Else
                writeln('File Error!');
            End
        End
    Until name='';
    writeln('Searching...');
  End;


Procedure Suchen(a,e:Long);
  Var i:  Long;
      cp: ^Char;
      kp: ^Kennung;
  Begin
    i:=a;
    While i<e Do
      Begin
        cp:=ptr(i);
        If cp^='H' Then
          Begin
            kp:=ptr(i);
            If (kp^.Zahl1=26731) Then
              If (kp^.Zahl2=4711) Then
                If kp^.s='HIMPELPASCAL' Then
                  Begin
                    write('Found: ');
                    WriteHex(kp^.Anfang);
                    write(' - ');
                    WriteHex(kp^.Ende);
                    writeln('  (',kp^.Ende-kp^.Anfang,' Bytes)');
                    SaveMemory(kp^.Anfang,kp^.Ende);
                  End
          End;
        i:=i+2
      End
  End;

Begin
  Base:=SysBase;
  writeln('Rescue - Last hope for Himpelpascal Sources');
  writeln;
  writeln('Searching in ChipMem...');
  Suchen($000000,Base^.MaxLocMem);
  writeln('Searching in FastMem...');
  Suchen($c00000,Long(Base^.MaxExtMem));
End.