home *** CD-ROM | disk | FTP | other *** search
/ Merciful 5 / Merciful - Disc 5.iso / software / p / pcqpascalv1.2d.lha / Examples2 / SaveKick2File / SaveKick2File.p < prev   
Encoding:
Text File  |  1997-05-06  |  2.8 KB  |  101 lines
  1.  
  2. {
  3.   -----------------------------------------------------------------------
  4.   -                                      -
  5.   -  SaveKick2File  -  Version 1.1,       (C)1992  by  Bernd Künnen      -
  6.   -                            Neuringe 75      -
  7.   -   This programm is Freeware,            44777 Twist      -
  8.   -   coded in 03.1991 in PCQ-Pascal(1.2b).                  -
  9.   -                                      -
  10.   -   Usage : SaveKick2file  filename                      -
  11.   -                                      -
  12.   -----------------------------------------------------------------------
  13. }
  14.  
  15. Program SaveKick;
  16.  
  17. {$I "include:libraries/dos.i"       }
  18. {$I "include:Utils/parameters.i"   }
  19. {$I "include:exec/exec.i"       }
  20. {$I "include:exec/execbase.i"       }
  21. {$I "include:Utils/stringlib.i"    }
  22.  
  23.  
  24. CONST
  25.     Kick256 : Integer = 256*1024;        { 512 bzw. 256 K }
  26.     Kick512 : Integer = 512*1024;
  27.     exec    : Integer = $0004;        { in $4 ist Ptr auf Execbase }
  28.  
  29. TYPE        
  30.     adrptr = ^Address;    { um nachher an den execbaseptr zu kommen }
  31.  
  32. VAR
  33.     KickMem        : Address;
  34.     KickSize    : Integer;
  35.     MyHandle    : FileHandle;
  36.     myfile        : String;
  37.  
  38.     myexecbaseptr    : execbaseptr;
  39.  
  40.  
  41. { **** Sorgt für ein sauberes Verlassen des Programms, egal wo man  ****
  42.   **** aussteigt :                            **** }
  43.  
  44. PROCEDURE cleanexit(why : String ; rtcode : Integer);
  45. BEGIN
  46.     { ## Ausgabe ins CLI, warum das Program verlassen ## }
  47.     { ## werden mußte, inkl.Returncode f. Batchfiles  ## }
  48.  
  49.     IF MyHandle<>NIL THEN  DOSClose(MyHandle);
  50.     IF why<>NIL THEN writeln(why);
  51.     exit(rtcode);
  52. END;
  53.  
  54.  
  55.  
  56.  
  57.  
  58. { **************  Hier nun endlich die Hauptschleife  ************** }
  59.  
  60.  
  61. BEGIN
  62.  
  63.   writeln(" SaveKick2File V1.1, (C)1992 B.Künnen\n");
  64.  
  65.   myfile:=AllocString(80);    { Buffer für 79 chars holen }
  66.  
  67.   GetParam(1,myfile);        { CLI-Argument in Buffer kopieren }
  68.  
  69.   IF strlen(myfile)=0 THEN    { Wenn kein CLI-Arg., dann nachfragen } 
  70.   BEGIN
  71.     write("Save actual Kickstart 2 file named : ");
  72.     readln(myfile);
  73.     IF strlen(myfile)=0 THEN cleanexit("No filename !",10);
  74.   END;
  75.  
  76.   myexecbaseptr:=Address(adrptr(exec)^);    { ExecbasePtr holen }
  77.  
  78.   IF myexecbaseptr^.LibNode.lib_Version<37 then    { Version vergleichen }
  79.   begin
  80.     writeln("Saving 256K - Kickstart...");
  81.     KickMem:=Address($fc0000);        { version<37 Then Kick1.3 or lower }
  82.     Kicksize:=Kick256;
  83.   end else begin
  84.     writeln("Saving 512K - Kickstart...");    { >=37 -> 2.0 or higher Kickstart }
  85.     KickMem:=Address($f80000);
  86.     Kicksize:=Kick512;
  87.   end;
  88.  
  89.   { Open file and test if ok ... }
  90.   MyHandle:=DOSOpen(myfile,MODE_NEWFILE);
  91.   IF MyHandle=NIL THEN cleanexit("Can`t open output-file.",5);
  92.  
  93.   { Write Kickstart 2 File }
  94.   IF DOSWrite(MyHandle,KickMem,KickSize)<>KickSize
  95.     THEN cleanexit("Error writing Kickstart.",5);
  96.  
  97.  
  98.   Delay(50);                { eine taktvolle Sekunden ...... }
  99.   cleanexit(NIL,0);            { bye bye baby .... }
  100. END.
  101.